library(dplyr)
library(kableExtra)
library(ggplot2)
library(knitr)
library(corrplot)
library(FactoMineR)
library(ggdendro)
library(GGally)
library(caret)
library(splines)
library(tidyr)

options(knitr.table.format = "html")

#Funciones para los graficos
give.n <- function(x,n){
  return(c(y = mean(x)*1.5, label = length(x)))
}
give1.n<-function(x,n){
  return(c(y = mean(x)*1.5, label = length(x)))
}

my_rg1 <- function(data, mapping, ...){
  
  p <- ggplot(data = data, mapping = mapping) + 
    
    geom_point() +
    geom_smooth(method='loess', fill="red", color="red",se=FALSE) +
    geom_smooth(method='lm', fill="cyan", color="cyan",se=FALSE) 
    
  p
  
}
my_rg2 <- function(data, mapping, ...){
  
  p <- ggplot(data = data,mapping=mapping) + 
    
    geom_point() + 
    
    geom_smooth(method='lm',formula=y~splines::bs(x),fill='darkorchid3',color='darkorchid3',se=FALSE) +
    
    geom_smooth(method='lm',formula=y~poly(x),fill='orangered',color='orangered',se=FALSE)
  
  p
  
}
my_rg3 <- function(data, mapping, ...){
 
  p <- ggplot(data = data, mapping = mapping) + 
    
    geom_point() + 
    
    geom_smooth(method='lm',formula=y~splines::bs(x),fill='darkgreen',color='darkgreen',alpha=.1) +
    
    geom_smooth(method='loess', fill="firebrick1", color="firebrick1",alpha=.1)
  
  p
  
}
#Solo para las discretas
my_rg4 <- function(data, mapping, ...){

  p <- ggplot(data = data, mapping = mapping) + 
    
    geom_point() + 
    
    geom_smooth(method='lm',fill='purple',color='purple',alpha=.3)
  
  p
  
}

#Funcion para regresion
normalize <- function(x) {
  return ((x - min(x)) / (max(x) - min(x))) }

1 PREPARACION

1.1 ESTRUCTURA DE LOS DATOS

Tenemos un archivo de entrenamiento para realizar un aprendizaje supervisado formado por 1460 casos con 81 variables.

Una de ellas es nuestro objetivo SalePrice, y debemos ser capaces de predecir esa variable con el dataframe Test que se nos proporciona, que es de 1459 casos.

Otra variable importante es la primera, Id que nos identifica de manera única cada registro.

En el dataframe Train tenemos los 1460 primeros.

En el dataframe Test tenemos desde el 1461 hasta el 2919

Tenemos varios tipos de variables, como se vera en el siguiente epígrafe, además de las cuales cambiaremos los tipos de algunas.

Hay que realizar una limpieza y control exhaustiva de todos los datos, haciendo énfasis en los valores NA

Para realizar una preparación adecuada y buscar un modelo hay que unir los dos dataframe creando los datos que nos faltan en Test (SalePrice la variable objetivo ) y poniendo como valor NA

url_test="https://www.kaggle.com/c/house-prices-advanced-regression-techniques/download/test.csv"
url_train="https://www.kaggle.com/c/house-prices-advanced-regression-techniques/download/train.csv"

train<-read.csv("train.csv",sep = ",", header=TRUE,stringsAsFactors = FALSE)
test<-read.csv("test.csv",sep=",",header=TRUE,stringsAsFactors = FALSE)

summary(train)
##        Id           MSSubClass      MSZoning          LotFrontage    
##  Min.   :   1.0   Min.   : 20.0   Length:1460        Min.   : 21.00  
##  1st Qu.: 365.8   1st Qu.: 20.0   Class :character   1st Qu.: 59.00  
##  Median : 730.5   Median : 50.0   Mode  :character   Median : 69.00  
##  Mean   : 730.5   Mean   : 56.9                      Mean   : 70.05  
##  3rd Qu.:1095.2   3rd Qu.: 70.0                      3rd Qu.: 80.00  
##  Max.   :1460.0   Max.   :190.0                      Max.   :313.00  
##                                                      NA's   :259     
##     LotArea          Street             Alley             LotShape        
##  Min.   :  1300   Length:1460        Length:1460        Length:1460       
##  1st Qu.:  7554   Class :character   Class :character   Class :character  
##  Median :  9478   Mode  :character   Mode  :character   Mode  :character  
##  Mean   : 10517                                                           
##  3rd Qu.: 11602                                                           
##  Max.   :215245                                                           
##                                                                           
##  LandContour         Utilities          LotConfig        
##  Length:1460        Length:1460        Length:1460       
##  Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character  
##                                                          
##                                                          
##                                                          
##                                                          
##   LandSlope         Neighborhood        Condition1       
##  Length:1460        Length:1460        Length:1460       
##  Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character  
##                                                          
##                                                          
##                                                          
##                                                          
##   Condition2          BldgType          HouseStyle         OverallQual    
##  Length:1460        Length:1460        Length:1460        Min.   : 1.000  
##  Class :character   Class :character   Class :character   1st Qu.: 5.000  
##  Mode  :character   Mode  :character   Mode  :character   Median : 6.000  
##                                                           Mean   : 6.099  
##                                                           3rd Qu.: 7.000  
##                                                           Max.   :10.000  
##                                                                           
##   OverallCond      YearBuilt     YearRemodAdd   RoofStyle        
##  Min.   :1.000   Min.   :1872   Min.   :1950   Length:1460       
##  1st Qu.:5.000   1st Qu.:1954   1st Qu.:1967   Class :character  
##  Median :5.000   Median :1973   Median :1994   Mode  :character  
##  Mean   :5.575   Mean   :1971   Mean   :1985                     
##  3rd Qu.:6.000   3rd Qu.:2000   3rd Qu.:2004                     
##  Max.   :9.000   Max.   :2010   Max.   :2010                     
##                                                                  
##    RoofMatl         Exterior1st        Exterior2nd       
##  Length:1460        Length:1460        Length:1460       
##  Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character  
##                                                          
##                                                          
##                                                          
##                                                          
##   MasVnrType          MasVnrArea      ExterQual          ExterCond        
##  Length:1460        Min.   :   0.0   Length:1460        Length:1460       
##  Class :character   1st Qu.:   0.0   Class :character   Class :character  
##  Mode  :character   Median :   0.0   Mode  :character   Mode  :character  
##                     Mean   : 103.7                                        
##                     3rd Qu.: 166.0                                        
##                     Max.   :1600.0                                        
##                     NA's   :8                                             
##   Foundation          BsmtQual           BsmtCond        
##  Length:1460        Length:1460        Length:1460       
##  Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character  
##                                                          
##                                                          
##                                                          
##                                                          
##  BsmtExposure       BsmtFinType1         BsmtFinSF1     BsmtFinType2      
##  Length:1460        Length:1460        Min.   :   0.0   Length:1460       
##  Class :character   Class :character   1st Qu.:   0.0   Class :character  
##  Mode  :character   Mode  :character   Median : 383.5   Mode  :character  
##                                        Mean   : 443.6                     
##                                        3rd Qu.: 712.2                     
##                                        Max.   :5644.0                     
##                                                                           
##    BsmtFinSF2        BsmtUnfSF       TotalBsmtSF       Heating         
##  Min.   :   0.00   Min.   :   0.0   Min.   :   0.0   Length:1460       
##  1st Qu.:   0.00   1st Qu.: 223.0   1st Qu.: 795.8   Class :character  
##  Median :   0.00   Median : 477.5   Median : 991.5   Mode  :character  
##  Mean   :  46.55   Mean   : 567.2   Mean   :1057.4                     
##  3rd Qu.:   0.00   3rd Qu.: 808.0   3rd Qu.:1298.2                     
##  Max.   :1474.00   Max.   :2336.0   Max.   :6110.0                     
##                                                                        
##   HeatingQC          CentralAir         Electrical          X1stFlrSF   
##  Length:1460        Length:1460        Length:1460        Min.   : 334  
##  Class :character   Class :character   Class :character   1st Qu.: 882  
##  Mode  :character   Mode  :character   Mode  :character   Median :1087  
##                                                           Mean   :1163  
##                                                           3rd Qu.:1391  
##                                                           Max.   :4692  
##                                                                         
##    X2ndFlrSF     LowQualFinSF       GrLivArea     BsmtFullBath   
##  Min.   :   0   Min.   :  0.000   Min.   : 334   Min.   :0.0000  
##  1st Qu.:   0   1st Qu.:  0.000   1st Qu.:1130   1st Qu.:0.0000  
##  Median :   0   Median :  0.000   Median :1464   Median :0.0000  
##  Mean   : 347   Mean   :  5.845   Mean   :1515   Mean   :0.4253  
##  3rd Qu.: 728   3rd Qu.:  0.000   3rd Qu.:1777   3rd Qu.:1.0000  
##  Max.   :2065   Max.   :572.000   Max.   :5642   Max.   :3.0000  
##                                                                  
##   BsmtHalfBath        FullBath        HalfBath       BedroomAbvGr  
##  Min.   :0.00000   Min.   :0.000   Min.   :0.0000   Min.   :0.000  
##  1st Qu.:0.00000   1st Qu.:1.000   1st Qu.:0.0000   1st Qu.:2.000  
##  Median :0.00000   Median :2.000   Median :0.0000   Median :3.000  
##  Mean   :0.05753   Mean   :1.565   Mean   :0.3829   Mean   :2.866  
##  3rd Qu.:0.00000   3rd Qu.:2.000   3rd Qu.:1.0000   3rd Qu.:3.000  
##  Max.   :2.00000   Max.   :3.000   Max.   :2.0000   Max.   :8.000  
##                                                                    
##   KitchenAbvGr   KitchenQual         TotRmsAbvGrd     Functional       
##  Min.   :0.000   Length:1460        Min.   : 2.000   Length:1460       
##  1st Qu.:1.000   Class :character   1st Qu.: 5.000   Class :character  
##  Median :1.000   Mode  :character   Median : 6.000   Mode  :character  
##  Mean   :1.047                      Mean   : 6.518                     
##  3rd Qu.:1.000                      3rd Qu.: 7.000                     
##  Max.   :3.000                      Max.   :14.000                     
##                                                                        
##    Fireplaces    FireplaceQu         GarageType         GarageYrBlt  
##  Min.   :0.000   Length:1460        Length:1460        Min.   :1900  
##  1st Qu.:0.000   Class :character   Class :character   1st Qu.:1961  
##  Median :1.000   Mode  :character   Mode  :character   Median :1980  
##  Mean   :0.613                                         Mean   :1979  
##  3rd Qu.:1.000                                         3rd Qu.:2002  
##  Max.   :3.000                                         Max.   :2010  
##                                                        NA's   :81    
##  GarageFinish         GarageCars      GarageArea      GarageQual       
##  Length:1460        Min.   :0.000   Min.   :   0.0   Length:1460       
##  Class :character   1st Qu.:1.000   1st Qu.: 334.5   Class :character  
##  Mode  :character   Median :2.000   Median : 480.0   Mode  :character  
##                     Mean   :1.767   Mean   : 473.0                     
##                     3rd Qu.:2.000   3rd Qu.: 576.0                     
##                     Max.   :4.000   Max.   :1418.0                     
##                                                                        
##   GarageCond         PavedDrive          WoodDeckSF      OpenPorchSF    
##  Length:1460        Length:1460        Min.   :  0.00   Min.   :  0.00  
##  Class :character   Class :character   1st Qu.:  0.00   1st Qu.:  0.00  
##  Mode  :character   Mode  :character   Median :  0.00   Median : 25.00  
##                                        Mean   : 94.24   Mean   : 46.66  
##                                        3rd Qu.:168.00   3rd Qu.: 68.00  
##                                        Max.   :857.00   Max.   :547.00  
##                                                                         
##  EnclosedPorch      X3SsnPorch      ScreenPorch        PoolArea      
##  Min.   :  0.00   Min.   :  0.00   Min.   :  0.00   Min.   :  0.000  
##  1st Qu.:  0.00   1st Qu.:  0.00   1st Qu.:  0.00   1st Qu.:  0.000  
##  Median :  0.00   Median :  0.00   Median :  0.00   Median :  0.000  
##  Mean   : 21.95   Mean   :  3.41   Mean   : 15.06   Mean   :  2.759  
##  3rd Qu.:  0.00   3rd Qu.:  0.00   3rd Qu.:  0.00   3rd Qu.:  0.000  
##  Max.   :552.00   Max.   :508.00   Max.   :480.00   Max.   :738.000  
##                                                                      
##     PoolQC             Fence           MiscFeature       
##  Length:1460        Length:1460        Length:1460       
##  Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character  
##                                                          
##                                                          
##                                                          
##                                                          
##     MiscVal             MoSold           YrSold       SaleType        
##  Min.   :    0.00   Min.   : 1.000   Min.   :2006   Length:1460       
##  1st Qu.:    0.00   1st Qu.: 5.000   1st Qu.:2007   Class :character  
##  Median :    0.00   Median : 6.000   Median :2008   Mode  :character  
##  Mean   :   43.49   Mean   : 6.322   Mean   :2008                     
##  3rd Qu.:    0.00   3rd Qu.: 8.000   3rd Qu.:2009                     
##  Max.   :15500.00   Max.   :12.000   Max.   :2010                     
##                                                                       
##  SaleCondition        SalePrice     
##  Length:1460        Min.   : 34900  
##  Class :character   1st Qu.:129975  
##  Mode  :character   Median :163000  
##                     Mean   :180921  
##                     3rd Qu.:214000  
##                     Max.   :755000  
##

str(train)
## 'data.frame':    1460 obs. of  81 variables:
##  $ Id           : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ MSSubClass   : int  60 20 60 70 60 50 20 60 50 190 ...
##  $ MSZoning     : chr  "RL" "RL" "RL" "RL" ...
##  $ LotFrontage  : int  65 80 68 60 84 85 75 NA 51 50 ...
##  $ LotArea      : int  8450 9600 11250 9550 14260 14115 10084 10382 6120 7420 ...
##  $ Street       : chr  "Pave" "Pave" "Pave" "Pave" ...
##  $ Alley        : chr  NA NA NA NA ...
##  $ LotShape     : chr  "Reg" "Reg" "IR1" "IR1" ...
##  $ LandContour  : chr  "Lvl" "Lvl" "Lvl" "Lvl" ...
##  $ Utilities    : chr  "AllPub" "AllPub" "AllPub" "AllPub" ...
##  $ LotConfig    : chr  "Inside" "FR2" "Inside" "Corner" ...
##  $ LandSlope    : chr  "Gtl" "Gtl" "Gtl" "Gtl" ...
##  $ Neighborhood : chr  "CollgCr" "Veenker" "CollgCr" "Crawfor" ...
##  $ Condition1   : chr  "Norm" "Feedr" "Norm" "Norm" ...
##  $ Condition2   : chr  "Norm" "Norm" "Norm" "Norm" ...
##  $ BldgType     : chr  "1Fam" "1Fam" "1Fam" "1Fam" ...
##  $ HouseStyle   : chr  "2Story" "1Story" "2Story" "2Story" ...
##  $ OverallQual  : int  7 6 7 7 8 5 8 7 7 5 ...
##  $ OverallCond  : int  5 8 5 5 5 5 5 6 5 6 ...
##  $ YearBuilt    : int  2003 1976 2001 1915 2000 1993 2004 1973 1931 1939 ...
##  $ YearRemodAdd : int  2003 1976 2002 1970 2000 1995 2005 1973 1950 1950 ...
##  $ RoofStyle    : chr  "Gable" "Gable" "Gable" "Gable" ...
##  $ RoofMatl     : chr  "CompShg" "CompShg" "CompShg" "CompShg" ...
##  $ Exterior1st  : chr  "VinylSd" "MetalSd" "VinylSd" "Wd Sdng" ...
##  $ Exterior2nd  : chr  "VinylSd" "MetalSd" "VinylSd" "Wd Shng" ...
##  $ MasVnrType   : chr  "BrkFace" "None" "BrkFace" "None" ...
##  $ MasVnrArea   : int  196 0 162 0 350 0 186 240 0 0 ...
##  $ ExterQual    : chr  "Gd" "TA" "Gd" "TA" ...
##  $ ExterCond    : chr  "TA" "TA" "TA" "TA" ...
##  $ Foundation   : chr  "PConc" "CBlock" "PConc" "BrkTil" ...
##  $ BsmtQual     : chr  "Gd" "Gd" "Gd" "TA" ...
##  $ BsmtCond     : chr  "TA" "TA" "TA" "Gd" ...
##  $ BsmtExposure : chr  "No" "Gd" "Mn" "No" ...
##  $ BsmtFinType1 : chr  "GLQ" "ALQ" "GLQ" "ALQ" ...
##  $ BsmtFinSF1   : int  706 978 486 216 655 732 1369 859 0 851 ...
##  $ BsmtFinType2 : chr  "Unf" "Unf" "Unf" "Unf" ...
##  $ BsmtFinSF2   : int  0 0 0 0 0 0 0 32 0 0 ...
##  $ BsmtUnfSF    : int  150 284 434 540 490 64 317 216 952 140 ...
##  $ TotalBsmtSF  : int  856 1262 920 756 1145 796 1686 1107 952 991 ...
##  $ Heating      : chr  "GasA" "GasA" "GasA" "GasA" ...
##  $ HeatingQC    : chr  "Ex" "Ex" "Ex" "Gd" ...
##  $ CentralAir   : chr  "Y" "Y" "Y" "Y" ...
##  $ Electrical   : chr  "SBrkr" "SBrkr" "SBrkr" "SBrkr" ...
##  $ X1stFlrSF    : int  856 1262 920 961 1145 796 1694 1107 1022 1077 ...
##  $ X2ndFlrSF    : int  854 0 866 756 1053 566 0 983 752 0 ...
##  $ LowQualFinSF : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ GrLivArea    : int  1710 1262 1786 1717 2198 1362 1694 2090 1774 1077 ...
##  $ BsmtFullBath : int  1 0 1 1 1 1 1 1 0 1 ...
##  $ BsmtHalfBath : int  0 1 0 0 0 0 0 0 0 0 ...
##  $ FullBath     : int  2 2 2 1 2 1 2 2 2 1 ...
##  $ HalfBath     : int  1 0 1 0 1 1 0 1 0 0 ...
##  $ BedroomAbvGr : int  3 3 3 3 4 1 3 3 2 2 ...
##  $ KitchenAbvGr : int  1 1 1 1 1 1 1 1 2 2 ...
##  $ KitchenQual  : chr  "Gd" "TA" "Gd" "Gd" ...
##  $ TotRmsAbvGrd : int  8 6 6 7 9 5 7 7 8 5 ...
##  $ Functional   : chr  "Typ" "Typ" "Typ" "Typ" ...
##  $ Fireplaces   : int  0 1 1 1 1 0 1 2 2 2 ...
##  $ FireplaceQu  : chr  NA "TA" "TA" "Gd" ...
##  $ GarageType   : chr  "Attchd" "Attchd" "Attchd" "Detchd" ...
##  $ GarageYrBlt  : int  2003 1976 2001 1998 2000 1993 2004 1973 1931 1939 ...
##  $ GarageFinish : chr  "RFn" "RFn" "RFn" "Unf" ...
##  $ GarageCars   : int  2 2 2 3 3 2 2 2 2 1 ...
##  $ GarageArea   : int  548 460 608 642 836 480 636 484 468 205 ...
##  $ GarageQual   : chr  "TA" "TA" "TA" "TA" ...
##  $ GarageCond   : chr  "TA" "TA" "TA" "TA" ...
##  $ PavedDrive   : chr  "Y" "Y" "Y" "Y" ...
##  $ WoodDeckSF   : int  0 298 0 0 192 40 255 235 90 0 ...
##  $ OpenPorchSF  : int  61 0 42 35 84 30 57 204 0 4 ...
##  $ EnclosedPorch: int  0 0 0 272 0 0 0 228 205 0 ...
##  $ X3SsnPorch   : int  0 0 0 0 0 320 0 0 0 0 ...
##  $ ScreenPorch  : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ PoolArea     : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ PoolQC       : chr  NA NA NA NA ...
##  $ Fence        : chr  NA NA NA NA ...
##  $ MiscFeature  : chr  NA NA NA NA ...
##  $ MiscVal      : int  0 0 0 0 0 700 0 350 0 0 ...
##  $ MoSold       : int  2 5 9 2 12 10 8 11 4 1 ...
##  $ YrSold       : int  2008 2007 2008 2006 2008 2009 2007 2009 2008 2008 ...
##  $ SaleType     : chr  "WD" "WD" "WD" "WD" ...
##  $ SaleCondition: chr  "Normal" "Normal" "Normal" "Abnorml" ...
##  $ SalePrice    : int  208500 181500 223500 140000 250000 143000 307000 200000 129900 118000 ...

dim(train)
## [1] 1460   81

AuxTrain<-train
AuxTest<-test
AuxTest$SalePrice<-NA
total<-rbind(AuxTrain,AuxTest)

1.2 VARIABLES

Vamos , en primer lugar, a hacer un estudio de las variables proporcionadas. Tenemos tres tipos :

Variables cuantificables
Variables categóricas .
Variables categóricas ya cuantificadas

1.2.1 VARIABLES CUANTIFICADAS (integer)

Codigo	Significado
ID	Identidad
LotFrontage	pies lineales de la calle conectados a la propiedad
LotArea	Tamaño del lote en pies cuadrados
YearBuilt	fecha de construcción original
YearRemodAdd	fecha de remodelación
MasVnrArea	área de chapa de la albañilería en pies cuadrados
BsmtFinSF1	Tipo 1 pies cuadrados terminados
BsmtFinSF2	Tipo 2 pies cuadrados terminados
BsmtUnfSF	Pies cuadrados sin terminar del área del sótano
TotalBsmtSF	pies cuadrados totales del área del sótano
1stFlrSF	primer piso pies cuadrados
2ndFlrSF	segundo piso pies cuadrados
LowQualFinSF	Pies cuadrados terminados de baja calidad (todos los pisos)
GrLivArea	pies cuadrados del área habitable sobre el nivel del suelo
BsmtFullBath	baños completos en el sótano
BsmtHalfBath	medio baño en el sótano
FullBath	baños completos por encima del grado
HalfBath	medio baño por encima del grado
Bedroom	Número de habitaciones sobre el nivel del sótano
Kitchen	Número de cocinas
TotRmsAbvGrd	Total de habitaciones por encima del grado (no incluye baños)
Fireplaces	cantidad de chimeneas
GarageYrBlt	año de garaje fue construido
GarageCars	tamaño del garaje en la capacidad del automóvil
GarageArea	Tamaño del garaje en pies cuadrados
WoodDeckSF	área de cubierta de madera en pies cuadrados
OpenPorchSF	área de porche abierto en pies cuadrados
EnclosedPorch	área de porche cerrado en pies cuadrados
3SsnPorch	área del porche de tres estaciones en pies cuadrados
ScreenPorch	área del porche de la pantalla en pies cuadrados
PoolArea	área de la piscina en pies cuadrados
MiscVal	$ Valor de la función miscelánea
MoSold	Mes vendido
YrSold	Año de venta
SalePrice	el precio de venta de la propiedad en dólares.

1.2.2 VARIABLES CATEGORICAS (Caracter)

MSZoning
la clasificación general de zonificación

Codigo	Tipo
A	Agriculture
C	Commercial
FV	Floating Village Residential
I	Industrial
RH	Residential High Density
RL	Residential Low Density
RP	Residential Low Density Park
RM	Residential Medium Density

Street
Tipo de acceso por carretera

Codigo	Tipo
Grvl	Gravel
Pave	Paved

Alley
tipo de acceso a callejones

Codigo	Tipo
Grvl	Gravel
Pave	Paved
NA	No alley access

LotShape
forma general de la propiedad

Codigo	Tipo
Reg	Regular
IR1	Slightly irregular
IR2	Moderately Irregular
IR3	Irregular

LandContour
planitud de la propiedad

Codigo	Tipo
Lvl	Near Flat/Level
Bnk	Banked - Quick and significant rise from street grade to building
HLS	Hillside - Significant slope from side to side
Low	Depression

Utilities
Tipo de utilidades disponibles

Codigo	Tipo
AllPub	All public Utilities (E,G,W,& S)
NoSewr	Electricity, Gas, and Water (Septic Tank)
NoSewa	Electricity and Gas Only
ELO	Electricity only

LotConfig
configuración del lote

Codigo	Tipo
Inside	Inside lot
Corner	Corner lot
CulDSac	Cul-de-sac
FR2	Frontage on 2 sides of property
FR3	Frontage on 3 sides of property

LandSlope
Pendiente de la propiedad

Codigo	Tipo
Gtl	Gentle slope
Mod	Moderate Slope
Sev	Severe Slope

Neighborhood
ubicaciones físicas dentro de los límites de la ciudad de Ames

Codigo	Tipo
Blmngtn	Bloomington Heights
Blueste	Bluestem
BrDale	Briardale
BrkSide	Brookside
ClearCr	Clear Creek
CollgCr	College Creek
Crawfor	Crawford
Edwards	Edwards
Gilbert	Gilbert
IDOTRR	Iowa DOT and Rail Road
MeadowV	Meadow Village
Mitchel	Mitchell
NAmes	North Ames
NoRidge	Northridge
NPkVill	Northpark Villa
NridgHt	Northridge Heights
NWAmes	Northwest Ames
OldTown	Old Town
SWISU	South & West of Iowa State University
Sawyer	Sawyer
SawyerW	Sawyer West
Somerst	Somerset
StoneBr	Stone Brook
Timber	Timberland
Veenker	Veenker

Condition1
proximidad a la carretera principal o ferrocarril

Codigo	Tipo
Artery	Adjacent to arterial street
Feedr	Adjacent to feeder street
Norm	Normal
PosA	Adjacent to postive off-site feature
PosN	Near positive off-site feature–park, greenbelt, etc.
RRAe	Adjacent to East-West Railroad
RRAn	Adjacent to North-South Railroad
RRNe	Within 200’ of East-West Railroad
RRNn	Within 200’ of North-South Railroad

Condition2
proximidad a la carretera principal o ferrocarril (si hay un segundo presente)

Codigo	Tipo
Artery	Adjacent to arterial street
Feedr	Adjacent to feeder street
Norm	Normal
PosA	Adjacent to postive off-site feature
PosN	Near positive off-site feature–park, greenbelt, etc.
RRAe	Adjacent to East-West Railroad
RRAn	Adjacent to North-South Railroad
RRNe	Within 200’ of East-West Railroad
RRNn	Within 200’ of North-South Railroad

BldgType
tipo de vivienda

Codigo	Tipo
1Fam	Single-family Detached
2fmCon	Two-family Conversion; originally built as one-family dwelling
Duplex	Duplex
TwnhsE	Townhouse End Unit
Twnhs	I Townhouse Inside Unit

HouseStyle
estilo de vivienda

Codigo	Tipo
1.5Fin	One and one-half story: 2nd level finished
1.5Unf	One and one-half story: 2nd level unfinished
1Story	One story
2.5Fin	Two and one-half story: 2nd level finished
2.5Unf	Two and one-half story: 2nd level unfinished
2Story	Two story
SFoyer	Split Foyer
SLvl	Split Level

RoofStyle
tipo de techo

Codigo	Tipo
Flat	Flat
Gable	Gable
Gambrel	Gabrel (Barn)
Hip	Hip
Mansard	Mansard
Shed	Shed

RoofMatl
material de techo

Codigo	Tipo
ClyTile	Clay or Tile
CompShg	Standard (Composite) Shingle
Membran	Membrane
Metal	Metal
Roll	Roll
Tar&Grv	Gravel & Tar
WdShake	Wood Shakes
WdShngl	Wood Shingles

Exterior1st
revestimiento exterior en la casa

Codigo	Tipo
AsbShng	Asbestos Shingles
AsphShn	Asphalt Shingles
BrkComm	Brick Common
BrkFace	Brick Face
CBlock	Cinder Block
CemntBd	Cement Board
HdBoard	Hard Board
ImStucc	Imitation Stucco
MetalSd	Metal Siding
Other	Other
Plywood	Plywood
PreCast	PreCast
Stone	Stone
Stucco	Stucco
VinylSd	Vinyl Siding
Wd Sdng	Wood Siding
WdShing	Wood Shingles

Exterior2nd
Cubierta exterior en la casa (si hay más de un material)

Codigo	Tipo
AsbShng	Asbestos Shingles
AsphShn	Asphalt Shingles
Brk Cmn	Brick Common
BrkFace	Brick Face
CBlock	Cinder Block
CmentBd	Cement Board
HdBoard	Hard Board
ImStucc	Imitation Stucco
MetalSd	Metal Siding
Other	Other
Plywood	Plywood
PreCast	PreCast
Stone	Stone
Stucco	Stucco
VinylSd	Vinyl Siding
Wd Sdng	Wood Siding
Wd Shng	Wood Shingles

MasVnrType
Tipo de chapa de mampostería

Codigo	Tipo
BrkCmn	Brick Common
BrkFace	Brick Face
Cblock	Cinder Block
None	None
Stone	Stone

ExterQual
calidad del material exterior

Codigo	Tipo
Ex	Excellent
Fa	Fair
Gd	Good
TA	Average/Typical
Po	Poor

ExterCond
estado actual del material en el exterior

Codigo	Tipo
Ex	Excellent
Fa	Fair
Gd	Good
Po	Poor
TA	Average/Typical

Foundation
tipo de fundación

Codigo	Tipo
BrkTil	Brick & Tile
CBlock	Cinder Block
PConc	Poured Contrete
Slab	Slab
Stone	Stone
Wood	Wood

BsmtQual
Altura del sótano

Codigo	Tipo
Ex	Excellent (100+ inches)
Fa	Fair (70-79 inches)
Gd	Good (90-99 inches)
NA	No Basement
Po	Poor (<70 inches
TA	Typical (80-89 inches)

BsmtCond
estado general del sótano

Codigo	Tipo
Ex	Excellent
Fa	Fair - dampness or some cracking or settling
Gd	Good
NA	No Basement
Po	Poor - Severe cracking, settling, or wetness
TA	Typical - slight dampness allowed

BsmtExposure
muros de sotano a ras de suelo o de jardín

Codigo	Tipo
Av	Average Exposure (split levels or foyers typically score average or above)
Gd	Good Exposure
Mn	Mimimum Exposure
NA	No Basement
No	No Exposure

BsmtFinType1
Calidad del área acabada del sótano

Codigo	Tipo
ALQ	Average Living Quarters
BLQ	Below Average Living Quarters
GLQ	Good Living Quarters
LwQ	Low Quality
NA	No Basement
Rec	Average Rec Room
Unf	Unfinshed

BsmtFinType2
Calidad del segundo área terminada (si está presente)

Codigo	Tipo
ALQ	Average Living Quarters
BLQ	Below Average Living Quarters
GLQ	Good Living Quarters
LwQ	Low Quality
NA	No Basement
Rec	Average Rec Room
Unf	Unfinshed

Heating
tipo de calefacción

Codigo	Tipo
Floor	Floor Furnace
GasA	Gas forced warm air furnace
GasW	Gas hot water or steam heat
Grav	Gravity furnace
OthW	Hot water or steam heat other than gas
Wall	Wall furnace

HeatingQC
Calidad y condición de la calefacción

Codigo	Tipo
Ex	Excellent
Fa	Fair
Gd	Good
Po	Poor
TA	Average/Typical

CentralAir
Aire acondicionado central

Codigo	Tipo
N	No
Y	Yes

Electrical
sistema eléctrico

Codigo	Tipo
FuseA	Fuse Box over 60 AMP and all Romex wiring (Average)
FuseF	60 AMP Fuse Box and mostly Romex wiring (Fair)
FuseP	60 AMP Fuse Box and mostly knob & tube wiring (poor)
Mix	Mixed
SBrkr	Standard Circuit Breakers & Romex

KitchenQual
calidad de la cocina

Codigo	Tipo
Ex	Excellent
Fa	Fair
Gd	Good
Po	Poor
TA	Typical/Average

Functional
calificación de la funcionalidad del hogar

Codigo	Tipo
Maj1	Major Deductions 1
Maj2	Major Deductions 2
Min1	Minor Deductions 1
Min2	Minor Deductions 2
Mod	Moderate Deductions
Sal	Salvage only
Sev	Severely Damaged
Typ	Typical Functionality

FireplaceQu
calidad de la chimenea

Codigo	Tipo
Ex	Excellent - Exceptional Masonry Fireplace
Fa	Fair - Prefabricated Fireplace in basement
Gd	Good - Masonry Fireplace in main level
NA	No Fireplace
Po	Poor - Ben Franklin Stove
TA	Average - Prefabricated Fireplace in main living area or Masonry Fireplace in basement

GarageType
ubicación del garaje

Codigo	Tipo
2Types	More than one type of garage
Attchd	Attached to home
Basment	Basement Garage
BuiltIn	Built-In (Garage part of house - typically has room above garage)
CarPort	Car Port
Detchd	Detached from home
NA	No Garage

GarageFinish
acabado interior del garaje

Codigo	Tipo
Fin	Finished
RFn	Rough Finished
Unf	Unfinished
NA	No Garage

GarageQual
calidad de garaje

Codigo	Tipo
Ex	Excellent
Fa	Fair
Gd	Good
NA	No Garage
Po	Poor
TA	Typical/Average

GarageCond
condición de garaje

Codigo	Tipo
Ex	Excellent
Fa	Fair
Gd	Good
NA	No Garage
Po	Poor
TA	Typical/Average

PavedDrive
calzada pavimentada

Codigo	Tipo
N	Dirt/Gravel
P	Partial Pavement
Y	Paved

PoolQC
calidad de la piscina

Codigo	Tipo
Ex	Excellent
Fa	Fair
Gd	Good
NA	No Pool
TA	Average/Typical

Fence
calidad de la cerca

Codigo	Tipo
GdPrv	Good Privacy
GdWo	Good Wood
MnPrv	Minimum Privacy
MnWw	Minimum Wood/Wire
NA	No Fence

MiscFeature
característica miscelánea no cubierta en otras categorías

Codigo	Tipo
Elev	Elevator
Gar2	2nd Garage (if not described in garage section)
NA	None
Othr	Other
Shed	Shed (over 100 SF)
TenC	Tennis Court

SaleType
Tipo de venta

Codigo	Tipo
COD	Court Officer Deed/Estate
Con	Contract 15% Down payment regular terms
ConLD	Contract Low Down
ConLI	Contract Low Interest
ConLw	Contract Low Down payment and low interest
CWD	Warranty Deed - Cash
New	Home just constructed and sold
Oth	Other
VWD	Warranty Deed - VA Loan
WD	Warranty Deed - Conventional

SaleCondition
Condiciones de venta

Codigo	Tipo
Abnorml	Abnormal Sale - trade, foreclosure, short sale
AdjLand	Adjoining Land Purchase
Alloca	Allocation - two linked properties with separate deeds, typically condo with a garage unit
Family	Sale between family members
Normal	Normal Sale
Partial	Home was not completed when last assessed (associated with New Homes)

1.2.3 VARIABLES CATEGORICAS YA CUANTIFICADAS (Integer)

Estas tienen la peculiaridad de que tienen asignada una numeración aunque realmente son categóricas

MSSubClass
la clase de construcción

Codigo	Tipo
20	1-STORY 1946 & NEWER ALL STYLES
30	1-STORY 1945 & OLDER
40	1-STORY W/FINISHED ATTIC ALL AGES
45	1-1/2 STORY - UNFINISHED ALL AGES
50	1-1/2 STORY FINISHED ALL AGES
60	2-STORY 1946 & NEWER
70	2-STORY 1945 & OLDER
75	2-1/2 STORY ALL AGES
80	SPLIT OR MULTI-LEVEL
85	SPLIT FOYER
90	DUPLEX - ALL STYLES AND AGES
120	1-STORY PUD (Planned Unit Development) - 1946 & NEWER
150	1-1/2 STORY PUD - ALL AGES
160	2-STORY PUD - 1946 & NEWER
180	PUD - MULTILEVEL - INCL SPLIT LEV/FOYER
190	2 FAMILY CONVERSION - ALL STYLES AND AGES

OverallQual
material general y calidad de acabado

Codigo	Tipo
10	Very Excellent
9	Excellent
8	Very Good
7	Good
6	Above Average
5	Average
4	Below Average
3	Fair
2	Poor
1	Very Poor

OverallCond
calificación de la condición general

Codigo	Tipo
10	Very Excellent
9	Excellent
8	Very Good
7	Good
6	Above Average
5	Average
4	Below Average
3	Fair
2	Poor
1	Very Poor

1.3 VALORES NULOS Y PERDIDOS

Veamos primero cuantos valores y en cuantas columnas tenemos NA

columnasNA <- which(colSums(is.na(total)) > 0)
kable(sort(colSums(sapply(total[columnasNA], is.na)), decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	x
PoolQC	2909
MiscFeature	2814
Alley	2721
Fence	2348
SalePrice	1459
FireplaceQu	1420
LotFrontage	486
GarageYrBlt	159
GarageFinish	159
GarageQual	159
GarageCond	159
GarageType	157
BsmtCond	82
BsmtExposure	82
BsmtQual	81
BsmtFinType2	80
BsmtFinType1	79
MasVnrType	24
MasVnrArea	23
MSZoning	4
Utilities	2
BsmtFullBath	2
BsmtHalfBath	2
Functional	2
Exterior1st	1
Exterior2nd	1
BsmtFinSF1	1
BsmtFinSF2	1
BsmtUnfSF	1
TotalBsmtSF	1
Electrical	1
KitchenQual	1
GarageCars	1
GarageArea	1
SaleType	1

Veamos un listado de los valores NA usados como categoria

Estaban marcados en rojo en su respectiva tabla

Alley tipo de acceso a callejones

Codigo	Significado
NA	No alley access

BsmtQual Altura del sótano

Codigo	Significado
NA	No Basement

BsmtCond estado general del sótano

Codigo	Significado
NA	No Basement

BsmtExposure muros de sotano a ras de suelo o de jardín

Codigo	Significado
NA	No Basement

BsmtFinType1 Calidad del área acabada del sótano

Codigo	Significado
NA	No Basement

BsmtFinType2 Calidad del segundo área terminada (si está presente)

Codigo	Significado
NA	No Basement

FireplaceQu calidad de la chimenea

Codigo	Significado
NA	No Fireplace

GarageType ubicación del garaje

Codigo	Significado
NA	No Garage

GarageFinish acabado interior del garaje

Codigo	Significado
NA	No Garage

GarageQual calidad de garaje

Codigo	Significado
NA	No Garage

GarageCond condición de garaje

Codigo	Significado
NA	No Garage

PoolQC calidad de la piscina

Codigo	Significado
NA	No Pool

Fence calidad de la cerca

Codigo	Significado
NA	No Fence

MiscFeature característica miscelánea no cubierta en otras categorías

Codigo	Significado
NA	None

Podemos apreciar que en todas las variables donde aparece (Callejon, Sotanos, Garages, Piscinas, Cerca y Varios), el sentido que se le da es “Ninguno” o “No existe”.

Por lo que podemos cambiar el código en esas variables por NONE

#Cambio los NA por NONE en cada variable
total$Alley[is.na(total$Alley)]<-'NONE'
total$BsmtQual[is.na(total$BsmtQual)]<-'NONE'
total$BsmtCond[is.na(total$BsmtCond)]<-'NONE'
total$BsmtExposure[is.na(total$BsmtExposure)]<-'NONE'
total$BsmtFinType1[is.na(total$BsmtFinType1)]<-'NONE'
total$BsmtFinType2[is.na(total$BsmtFinType2)]<-'NONE'
total$FireplaceQu[is.na(total$FireplaceQu)]<-'NONE'
total$GarageType[is.na(total$GarageType)]<-'NONE'
total$GarageFinish[is.na(total$GarageFinish)]<-'NONE'
total$GarageQual[is.na(total$GarageQual)]<-'NONE'
total$GarageCond[is.na(total$GarageCond)]<-'NONE'
total$PoolQC[is.na(total$PoolQC)]<-'NONE'
total$Fence[is.na(total$Fence)]<-'NONE'
total$MiscFeature[is.na(total$MiscFeature)]<-'NONE'

Volvemos a comprobar cuantas columnas quedan con valores NA

columnasNA <- which(colSums(is.na(total)) > 0)
kable(sort(colSums(sapply(total[columnasNA], is.na)), decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	x
SalePrice	1459
LotFrontage	486
GarageYrBlt	159
MasVnrType	24
MasVnrArea	23
MSZoning	4
Utilities	2
BsmtFullBath	2
BsmtHalfBath	2
Functional	2
Exterior1st	1
Exterior2nd	1
BsmtFinSF1	1
BsmtFinSF2	1
BsmtUnfSF	1
TotalBsmtSF	1
Electrical	1
KitchenQual	1
GarageCars	1
GarageArea	1
SaleType	1

Vemos ahora las variables que nos quedan por comprobar

1.3.1 GARAJE

 GarageYrBlt -->  159 registros        GarageCars -->     1 registros             GarageArea -->  1 registros

1.3.1.1 GARAGE TYPE

Vamos a ver con que valores de GarageType se correponden estos NA


prueba<-total%>%filter(is.na(total$GarageYrBlt))%>%select(Id,GarageType)
prueba[,2]<-as.factor(prueba[,2])
levels(prueba[,2])
## [1] "Detchd" "NONE"

Seleccionamos especificamente los registros que no tienen garaje

Ponemos a 0 el año en aquellos que no tienen garage

prueba<-total%>%filter(is.na(total$GarageYrBlt))%>%filter(GarageType=='NONE')%>%select(Id,GarageType)

total[prueba[,1],60]<-0

Vemos los registros que nos han quedado


prueba<-total%>%filter(is.na(total$GarageYrBlt))%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageCars,GarageArea,GarageQual,GarageCond)
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	GarageType	GarageYrBlt	GarageFinish	GarageCars	GarageArea	GarageQual	GarageCond
2127	Detchd	NA	NONE	1	360	NONE	NONE
2577	Detchd	NA	NONE	NA	NA	NONE	NONE

1.3.1.2 GARAGE CARS y GARAGE AREA

1.3.1.2.1 Registro 2577

Parece claro que este registro no tiene garage

total[2577,59]<-'NONE'
total[2577,60]<-0
total[2577,62]<-0
total[2577,63]<-0

Buscamos registros con GarageType y GarageCars iguales al registro 2127 y seleccionamos los mas usados

prueba2<-total%>%filter(GarageType=="Detchd"&GarageCars==1)%>%select(Id,YearBuilt,YearRemodAdd,GarageType,GarageYrBlt,GarageFinish,GarageCars,GarageArea,GarageQual,GarageCond)
freq<-as.data.frame(table(prueba2$GarageFinish,prueba2$GarageQual,prueba2$GarageCond))
kable(head(freq[order(freq$Freq,decreasing = TRUE),]))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	Var1	Var2	Var3	Freq
144	Unf	TA	TA	268
128	Unf	Fa	TA	40
32	Unf	Fa	Fa	25
48	Unf	TA	Fa	18
143	RFn	TA	TA	6
104	Unf	Fa	Po	4

Asignamos

total[2127,61]<-"Unf"
total[2127,64]<-"TA"
total[2127,65]<-"TA"

Miramos el valor superior entre YearBuilt y YearRemodAdd y lo asignamos a GarageYrBlt

kable(total%>%filter(Id==2127)%>%select(YearBuilt,YearRemodAdd))

YearBuilt	YearRemodAdd
1910	1983

total[2127,60]<-1983

1.3.2 SOTANO (BASEMENT)

 BsmtFullBath -->  2 registros        BsmtHalfBath -->  2 registros        BsmtFinSF1 -->  1 registro                        BsmtFinSF2 -->  1 registro          BsmtUnfSF -->  1 registro        TotalBsmtSF -->  1 registro

prueba<-total%>%filter(is.na(BsmtFullBath)|is.na(BsmtHalfBath))%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinSF1,BsmtFinType2,BsmtFinSF2,BsmtUnfSF,BsmtFullBath,BsmtHalfBath,TotalBsmtSF)
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	BsmtQual	BsmtCond	BsmtExposure	BsmtFinType1	BsmtFinSF1	BsmtFinType2	BsmtFinSF2	BsmtUnfSF	BsmtFullBath	BsmtHalfBath	TotalBsmtSF
2121	NONE	NONE	NONE	NONE	NA	NONE	NA	NA	NA	NA	NA
2189	NONE	NONE	NONE	NONE	0	NONE	0	0	NA	NA	0

Evidentemente ninguno de estos dos registros tiene sotano por lo que los registros que están con NA hay que ponerlos a 0

total[2121,35]<-0
total[2121,37]<-0
total[2121,38]<-0
total[2121,39]<-0
total[2121,48]<-0
total[2121,49]<-0

total[2189,48]<-0
total[2189,49]<-0

Verificamos campos discordantes de sotano

prueba<-total%>%filter(BsmtCond=='NONE'|BsmtQual=='NONE'|BsmtExposure=='NONE'|BsmtFinType1=='NONE'|BsmtFinType2=='NONE')%>%select(Id,BsmtCond,BsmtQual,BsmtExposure,BsmtFinType1,BsmtFinSF1,BsmtFinType2,BsmtFinSF2,BsmtUnfSF,TotalBsmtSF,BsmtFullBath,BsmtHalfBath)
kable(prueba%>%filter(BsmtCond!='NONE'|BsmtQual!='NONE'|BsmtExposure!='NONE'|BsmtFinType1!='NONE'|BsmtFinType2!='NONE'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	BsmtCond	BsmtQual	BsmtExposure	BsmtFinType1	BsmtFinSF1	BsmtFinType2	BsmtFinSF2	BsmtUnfSF	TotalBsmtSF	BsmtFullBath	BsmtHalfBath
333	TA	Gd	No	GLQ	1124	NONE	479	1603	3206	1	0
949	TA	Gd	NONE	Unf	0	Unf	0	936	936	0	0
1488	TA	Gd	NONE	Unf	0	Unf	0	1595	1595	0	0
2041	NONE	Gd	Mn	GLQ	1044	Rec	382	0	1426	1	0
2186	NONE	TA	No	BLQ	1033	Unf	0	94	1127	0	1
2218	Fa	NONE	No	Unf	0	Unf	0	173	173	0	0
2219	TA	NONE	No	Unf	0	Unf	0	356	356	0	0
2349	TA	Gd	NONE	Unf	0	Unf	0	725	725	0	0
2525	NONE	TA	Av	ALQ	755	Unf	0	240	995	0	0

Procedemos a modificar los campos discordantes por registros similares

1.3.2.0.1 Registro 333 (BsmtFinType2=NONE)

Buscamos registros parecidos y asignamos

prueba1<-total%>%filter(BsmtCond=='TA'& BsmtQual=='Gd'& BsmtExposure=='No'& BsmtFinType1=='GLQ' & BsmtFinType2!='Unf' & BsmtFullBath==1)%>%select(Id,BsmtCond,BsmtQual,BsmtExposure,BsmtFinType1,BsmtFinSF1,BsmtFinType2,BsmtFinSF2,BsmtUnfSF,TotalBsmtSF,BsmtFullBath,BsmtHalfBath)
sort(table(prueba1$BsmtFinType2),decreasing = TRUE)
## 
##  ALQ  Rec  BLQ  LwQ NONE 
##    4    2    1    1    1
total[333,36]<-'ALQ'

1.3.2.0.2 Registros 949,1488 y 2349 (BsmtExposure=NONE)

Estos tres registros coinciden en los campos salvo en BsmtUnSF

Buscamos registros parecidos, comparamos y asignamos

prueba1<-total%>%filter( BsmtFinType1=='Unf' & BsmtCond=='TA'& BsmtQual=='Gd' )%>%select(Id,BsmtExposure,BsmtUnfSF,TotalBsmtSF)
table(prueba1$BsmtExposure)
## 
##   Av   Gd   Mn   No NONE 
##   58   10   22  255    3

prop.table(table(prueba1$BsmtExposure))
## 
##         Av         Gd         Mn         No       NONE 
## 0.16666667 0.02873563 0.06321839 0.73275862 0.00862069

muro<-ggplot(prueba1,aes(x=BsmtExposure,y=BsmtUnfSF))
muro<-muro+geom_boxplot(varwidth = TRUE)
muro

No se aprecia relacion evidente entre el tamaño del sotano y el tipo de muro.

Ademas el campo con mas casos tiene casi un 75%. Lo aplicamos en estos registros

total[949,33]<-'No'
total[1488,33]<-'No'
total[2349,33]<-'No'

1.3.2.0.3 Registros 2041,2186 y 2525 (BsmtCond=NONE)

No tienen campos en comun. Buscamos por el valor mas representativo

table(total$BsmtCond)
## 
##   Fa   Gd NONE   Po   TA 
##  104  122   82    5 2606

Asignamos el valor TA

total[2041,32]<-'TA'
total[2186,32]<-'TA'
total[2525,32]<-'TA'

1.3.2.0.4 Registros 2218 y 2219 (BsmtQual=NONE)

Buscamos registros con campos comunes iguales

prueba1<-total%>%filter( BsmtExposure=='No' & BsmtFinType1=='Unf' )%>%select(Id,BsmtCond,BsmtQual,TotalBsmtSF)
kable(table(prueba1$BsmtQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
Ex	26
Fa	54
Gd	269
NONE	2
TA	338

Estan repartidos. Hay que buscar mas

Filtro por el campo BsmtCond que es diferente en cada registro

prueba1<-total%>%filter( BsmtCond=='Fa' & BsmtExposure=='No' & BsmtFinType1=='Unf' )%>%select(Id,BsmtCond,BsmtQual,TotalBsmtSF)
kable(table(prueba1$BsmtQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
Fa	13
Gd	2
NONE	1
TA	31

prueba1<-total%>%filter( BsmtCond=='TA' & BsmtExposure=='No' & BsmtFinType1=='Unf' )%>%select(Id,BsmtCond,BsmtQual,TotalBsmtSF)
kable(table(prueba1$BsmtQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
Ex	20
Fa	38
Gd	258
NONE	1
TA	304

En ambos casos el valor mas usado es ‘TA’. Lo aplicamos

total[2218,31]<-'TA'
total[2219,31]<-'TA'

1.3.3 MAMPOSTERIA (MasVnr)

 MasVnrType -->  24 registros        MaVnrArea -->  23 registros

Vamos a ver los registros con NA relacionados con la albañileria

prueba<-total%>%filter(is.na(MasVnrType))%>%select(Id,MasVnrType,MasVnrArea)
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	MasVnrType	MasVnrArea
235	NA	NA
530	NA	NA
651	NA	NA
937	NA	NA
974	NA	NA
978	NA	NA
1244	NA	NA
1279	NA	NA
1692	NA	NA
1707	NA	NA
1883	NA	NA
1993	NA	NA
2005	NA	NA
2042	NA	NA
2312	NA	NA
2326	NA	NA
2341	NA	NA
2350	NA	NA
2369	NA	NA
2593	NA	NA
2611	NA	198
2658	NA	NA
2687	NA	NA
2863	NA	NA

Uno de los elementos a seleccionar en MasVnrType es None. Ponemos los NA como None y el area a 0

total$MasVnrArea[is.na(total$MasVnrType)==TRUE]<-0
total$MasVnrType[is.na(total$MasVnrType)==TRUE]<-'None'

Compruebo si estan bien todos las areas con un tipo None

prueba<-total%>%filter(MasVnrType=='None' & MasVnrArea>0)%>%select(Id,MasVnrArea)
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	MasVnrArea
625	288
774	1
1231	1
1301	344
1335	312
1670	285
2453	1

Tenemos 7 registros que no tienen el area a 0 y no tienen mamposteria

total$MasVnrArea[total$MasVnrType=='None'& total$MasVnrArea>0]<-0

Compruebo si estan bien todos las areas con valor 0 sin tener un tipo None

prueba<-total%>%filter(MasVnrType!='None' & MasVnrArea==0)%>%select(Id,MasVnrType,MasVnrArea)
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	MasVnrType	MasVnrArea
689	BrkFace	0
1242	Stone	0
2320	BrkFace	0

Hay tres registros. Como no hay forma de saber el tipo de manposteria, la ponemos como ninguna

total[689,26]<-'None'
total[1242,26]<-'None'
total[2320,26]<-'None'

1.3.4 PROPIEDAD (Lot)

 LotFrontage -->  486 registros

Tenemos 486 registros con NA.

Este es un campo cuantitativo por lo que resultan mas difíciles de definir que los categóricos. Aquí buscamos en pies la longitud de la propiedad que limita con la calle.

Para poder calcularlo vamos a tener en cuenta que conocemos

LotArea área de la propiedad , que es cuantitativo,
LotShape , que es un factor que indica la configuración de la planta de la propiedad
LotConfig otro factor importante en Real State que indica la forma de la propiedad respecto a su entorno
Neighborhood, que es el entorno donde esta situada

Para obtener un valor que pueda ser comparado vamos a calcular la relación entre la fachada y la raíz cuadrada del área.

La forma que tiene la propiedad puede ser cuadrada, rectangular, trapezoidal, triangular, de forma irregular, etc. Elegimos la raíz cuadradada del lado de un cuadrado y calculamos la proporción entre el lado del cuadrado que tendría ese área y la longitud real de la fachada.

Esa medida la vamos a agrupar por el vecindario (Neighborhood), la forma de la propiedad (LotConfig) y la regularidad de esa forma (LotShape)

https://en.wikipedia.org/wiki/Land_lot

http://www.gimme-shelter.com/frontage-50043/

#registros con NA
prueba1<-total%>%filter(is.na(LotFrontage)==TRUE)
options(digits=4)
#resto de registros agrupados
prueba2<-total%>%filter(is.na(LotFrontage)==FALSE)%>%group_by(LotShape,LotConfig,Neighborhood)
#Calculo proporcion
prueba2[,82]<-prueba2$LotFrontage/sqrt(prueba2$LotArea)
#Numero y media de las proporciones por agrupaciones
prueba3<-prueba2%>%summarise(cuenta=n(),media=mean(V82))
# De cada registro con NA buscamos que agrupacion le corresponde y le asignamos la proporcion que le corresponde de su grupo adecuada a su area propia
for (i in 1:length(prueba1$Id)){
  lista<-which((prueba1[i,11]==prueba3$LotConfig)&(prueba1[i,8]==prueba3$LotShape)&(prueba1[i,13]==prueba3$Neighborhood))
  prueba1[i,82]<-round(prueba3[lista[1],5]*sqrt(prueba1[i,5]))
}
nrow(table(prueba1%>%filter(is.na(media)==TRUE)))
## [1] 40

Faltan 40 registros que no estan conformados por los tres campos.

Reducimos las agrupaciones a dos. LotConfig y Neighborhood

Realizamos las mismas operaciones que en el chunk anterior

prueba11<-prueba1%>%filter(is.na(media)==TRUE)
prueba22<-total%>%filter(is.na(LotFrontage)==FALSE)%>%group_by(LotConfig,Neighborhood)
prueba22[,82]<-prueba22$LotFrontage/sqrt(prueba22$LotArea)
prueba23<-prueba22%>%summarise(cuenta=n(),media=mean(V82))
for (i in 1:length(prueba11$Id)){
  lista<-which((prueba11[i,11]==prueba23$LotConfig)&(prueba11[i,13]==prueba23$Neighborhood))
  prueba11[i,82]<-round(prueba23[lista[1],4]*sqrt(prueba11[i,5]))
}
nrow(table(prueba11%>%filter(is.na(media)==TRUE)))
## [1] 4

Faltan 4 registros que no estan conformados por los dos campos.

Reducimos a Neighborhood y realizamos las misma operaciones

prueba111<-prueba11%>%filter(is.na(media)==TRUE)
prueba222<-total%>%filter(is.na(LotFrontage)==FALSE)%>%group_by(Neighborhood)
prueba222[,82]<-prueba222$LotFrontage/sqrt(prueba222$LotArea)
prueba223<-prueba222%>%summarise(cuenta=n(),media=mean(V82))
for (i in 1:length(prueba111$Id)){
  lista<-which(prueba111[i,13]==prueba223$Neighborhood)
  prueba111[i,82]<-round(prueba223[lista[1],3]*sqrt(prueba111[i,5]))
}
nrow(table(prueba111%>%filter(is.na(media)==TRUE)))
## [1] 0

Ya no quedan registros sin NA en media. Unimos todos los grupos de registros que hemos hecho registros. Reasignamos el valor de media a LotFrontage y ordenamos el conjunto

prueba<-rbind(prueba1[is.na(prueba1$media)==FALSE,],prueba11[is.na(prueba11$media)==FALSE,],prueba111[is.na(prueba111$media)==FALSE,])
prueba$LotFrontage<-prueba$media
total<-rbind(total[is.na(total$LotFrontage)==FALSE,],prueba[,1:81])
#reordenamos
total<-total%>%arrange(Id)

1.3.5 EXTERIOR

 Exterior1st -->  1 registro        Exterior2nd -->   1 registro

Tenemos dos variables categóricas con 1 NA cada una en el mismo registro.

kable(total%>%filter(is.na(Exterior1st)==TRUE)%>%select(Id,Exterior1st,Exterior2nd))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	Exterior1st	Exterior2nd
2152	NA	NA

kable(sort(table(total$Exterior1st),decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
VinylSd	1025
MetalSd	450
HdBoard	442
Wd Sdng	411
Plywood	221
CemntBd	126
BrkFace	87
WdShing	56
AsbShng	44
Stucco	43
BrkComm	6
AsphShn	2
CBlock	2
Stone	2
ImStucc	1

kable(sort(table(total$Exterior2nd),decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
VinylSd	1014
MetalSd	447
HdBoard	406
Wd Sdng	391
Plywood	270
CmentBd	126
Wd Shng	81
BrkFace	47
Stucco	47
AsbShng	38
Brk Cmn	22
ImStucc	15
Stone	6
AsphShn	4
CBlock	3
Other	1

Sin mas información escogemos lo mas frecuente

total[2152,24]<-'VinylSD'
total[2152,25]<-'VinylSD'

1.3.6 UTILIDADES (Utilities)

 Utilities -->  2 registros

Tenemos 2 registros con NA en este campo

Vemos como estan distribuidos

kable(total%>%filter(is.na(Utilities)==TRUE)%>%select(Id,Utilities))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	Utilities
1916	NA
1946	NA

kable(sort(table(total$Utilities),decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
AllPub	2916
NoSeWa	1

Como parece evidente ponemos estos dos registros como la inmensa mayoría. Aunque tenerlos casi todos iguales no servirá para predecir nada

total[1916,10]<-'AllPub'
total[1946,10]<-'AllPub'

1.3.7 FUNCIONAL (Functional)

 Functional -->  2 registros

Tenemos 2 registros con NA en este campo

kable(total%>%filter(is.na(Functional)==TRUE)%>%select(Id,Functional))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	Functional
2217	NA
2474	NA

kable(sort(table(total$Functional),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
Typ	2717
Min2	70
Min1	65
Mod	35
Maj1	19
Maj2	9
Sev	2

Ponemos estos registros como Typical que son la mayoría. No tenemos información para mas

total[2217,56]<-'Typ'
total[2474,56]<-'Typ'

1.3.8 ELECTRICO (Electrical)

 Electrical -->  1 registro

Tenemos 1 registro con NA en este campo

kable(total%>%filter(is.na(Electrical)==TRUE)%>%select(Id,Electrical))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	Electrical
1380	NA

kable(sort(table(total$Electrical),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
SBrkr	2671
FuseA	188
FuseF	50
FuseP	8
Mix	1

Ponemos este registro como la mayoría, el estándar

total[1380,43]<-'SBrkr'

1.3.9 COCINA (Kitchen)

 KitchenQual -->  1 registro

Tenemos 1 registro con NA

kable(total%>%filter(is.na(KitchenQual)==TRUE)%>%select(Id,KitchenQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	KitchenQual
1556	NA

kable(sort(table(total$KitchenQual),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
TA	1492
Gd	1151
Ex	205
Fa	70

Como solo es un registro podemos ponerle el valor mayoritario sin que afecte mucho

total[1556,54]<-'TA'

Por otro lado tenemos tres registros con un numero de cocinas por encima del suelo igual a 0, pero sin embargo su calidad es Typical

kable(total%>%filter(KitchenAbvGr==0)%>%select(Id,KitchenAbvGr,KitchenQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	KitchenAbvGr	KitchenQual
955	0	TA
2588	0	TA
2860	0	TA

En principio no es paradójico puesto que no existe la opción de NONE en KitchenQual

1.3.10 VENTA (Sale)

 SaleType -->  1 registro

Tenemos 1 registro con NA en el campo SaleType

kable(total%>%filter(is.na(SaleType)==TRUE)%>%select(Id))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id
2490

kable(sort(table(total$SaleType),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
WD	2525
New	239
COD	87
ConLD	26
CWD	12
ConLI	9
ConLw	8
Oth	7
Con	5

Como solo es un registro podemos ponerle el valor mayoritario sin que afecte mucho

total[2490,79]<-'WD'

1.3.11 ZONIFICACION

 MSZoning -->  4 registro

Tenemos 4 registros con NA

kable(total%>%filter(is.na(MSZoning)==TRUE)%>%select(Id))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id
1916
2217
2251
2905

kable(sort(table(total$MSZoning),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
RL	2265
RM	460
FV	139
RH	26
C (all)	25

En este caso vamos a ver la relación entre el tipo de zonificación y el barrio, MSZoning y Neighborhood

plotPru<-ggplot(data=total,aes(x=total$Neighborhood,y=total$MSZoning))
plotPru<-plotPru+geom_count()+labs(x="BARRIOS",y="ZONIFICACION")
plotPru<-plotPru+theme(axis.text.x = element_text(angle = 90,hjust=1,vjust=0.5),title = element_text(color="blue",size=12,lineheight = 1))
plotPru

Compruebo los registros con NA

kable(total%>%filter(is.na(MSZoning)==TRUE)%>%select(Id,MSZoning,Neighborhood))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	MSZoning	Neighborhood
1916	NA	IDOTRR
2217	NA	IDOTRR
2251	NA	IDOTRR
2905	NA	Mitchel

A destacar:

en IDOTRR donde tenemos tres registros no existe ninguna vivienda zonificada como RL que es la mayoritaria en el conjunto de Ames.
En el barrio de Mitchel , donde esta el otro registro, sí es RL la mayoritaria

Vuelvo a comprobar separando los barrios. Para los registros del barrio de IDOTRR

prueba1<-total%>%filter(is.na(MSZoning)==FALSE)%>%filter(Neighborhood=='IDOTRR')
kable(sort(table(prueba1$MSZoning),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
RM	68
C (all)	22

Escojo como valor mayoritario RM

total[1916,3]<-'RM'
total[2217,3]<-'RM'
total[2251,3]<-'RM'

Para el otro barrio

prueba1<-total%>%filter(is.na(MSZoning)==FALSE)%>%filter(Neighborhood=='Mitchel')
kable(sort(table(prueba1$MSZoning),decreasing=TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
RL	104
RM	9

Escojo como valor mas usado RL

total[2905,3]<-'RL'

1.3.12 CONCLUSION

Comprobamos cuantos valores nos quedan con NA

#Comprobamos cuantos NA nos quedan
ColumnasNA <- which(colSums(is.na(total)) > 0)
kable(sort(colSums(sapply(total[ColumnasNA], is.na)), decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	x
SalePrice	1459

Que es la variable objetivo

1.4 CONTRADICCIONES

Vamos a buscar contradicciones entre características similares

1.4.1 PISCINA (Pool)

No se puede establecer una relacion directa entre la calidad de la piscina y el area. Buscamos en la calidad general de la casa

kable(total%>%filter(PoolArea>0 & PoolQC=='NONE')%>%select(Id,PoolQC,PoolArea))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	PoolQC	PoolArea
2421	NONE	368
2504	NONE	444
2600	NONE	561

Tenemos tres registros que tienen un area de piscina sin tenerla

Vemos como están distribuidas las piscinas

kable(sort(table(total$PoolQC),decreasing = TRUE))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
NONE	2909
Ex	4
Gd	4
Fa	2

La gran mayoría de las casas no tienen piscina. Para poder encontrar un criterio con el que dar una cualificación a los registros que faltan buscaremos algún tipo de relación

prueba<-total%>%filter(PoolArea>0 )%>%select(Id,PoolQC,PoolArea,OverallQual,OverallCond)
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	PoolQC	PoolArea	OverallQual	OverallCond
198	Ex	512	8	4
811	Fa	648	6	6
1171	Gd	576	6	6
1183	Ex	555	10	5
1299	Gd	480	10	5
1387	Fa	519	7	5
1424	Gd	738	6	7
1975	Ex	144	10	5
2421	NONE	368	4	6
2504	NONE	444	6	5
2574	Ex	228	8	5
2600	NONE	561	3	5
2711	Gd	800	7	4



plotPru2<-ggplot(data=prueba,aes(x=prueba$PoolQC,y=prueba$OverallQual))
plotPru2<-plotPru2+geom_boxplot()
plotPru2



plotPru2<-ggplot(data=prueba,aes(x=prueba$PoolQC,y=prueba$PoolArea))
plotPru2<-plotPru2+geom_boxplot()
plotPru2

Parece que existe cierta relacion entre la calidad general y el area de piscina Vamos a verlo numericamente

options(digits = 3)
prueba$razon<-(prueba$OverallQual*100)/prueba$PoolArea
#Ordenamos
prueba<-prueba%>%arrange(desc(prueba$razon))
kable(prueba)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	PoolQC	PoolArea	OverallQual	OverallCond	razon
1975	Ex	144	10	5	6.944
2574	Ex	228	8	5	3.509
1299	Gd	480	10	5	2.083
1183	Ex	555	10	5	1.802
198	Ex	512	8	4	1.562
2504	NONE	444	6	5	1.351
1387	Fa	519	7	5	1.349
2421	NONE	368	4	6	1.087
1171	Gd	576	6	6	1.042
811	Fa	648	6	6	0.926
2711	Gd	800	7	4	0.875
1424	Gd	738	6	7	0.813
2600	NONE	561	3	5	0.535

Si se puede establecer una cierta relación , por lo que asignamos la calidad de la piscina asi

total[2504,73]<-'Gd'
total[2421,73]<-'Gd'
total[2600,73]<-'Fa'

1.4.2 CHIMENEA (Fireplace)

No existe contradiccion entre el numero de chimeneas y la calidad

nrow(total%>%filter(Fireplaces>0 & FireplaceQu=='NONE')%>%select(Id,Fireplaces,FireplaceQu,OverallQual,OverallCond))
## [1] 0

1.4.3 SOTANO (Basement)

En las areas tenemos que el area del tipo 1 + area del tipo 2 + area sin terminar = Area total

Comprobamos y buscamos incongruencias

prueba<-total%>%select(Id,TotalBsmtSF,BsmtFinSF1,BsmtFinSF2,BsmtUnfSF)
prueba[,2]<--prueba[,2]
prueba[,6]<-apply(prueba[,2:5],1,sum)
nrow(prueba%>%filter(V6>0))
## [1] 0

No existe ningun registro con el area mal

En los registros sin sotano compruebo que no exista algún campo que no corresponda

Existen 79 registros que no tienen sotano

prueba<-total%>%filter(BsmtQual=='NONE'|BsmtCond=='NONE'|BsmtExposure=='NONE'|BsmtFinType1=='NONE'|BsmtFinType2=='NONE')%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath)
prueba1<-prueba%>%filter(BsmtQual!='NONE'|BsmtCond!='NONE'|BsmtExposure!='NONE'|BsmtFinType1!='NONE'|BsmtFinType2!='NONE'|BsmtFullBath>0|BsmtHalfBath>0)%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath)
nrow(prueba1)
## [1] 0

Ninguno de ellos tiene incongruencias

Busco los sotanos existentes que no tienen area construida en el primer tipo

prueba<-total%>%filter(BsmtFinType1!='NONE' & BsmtFinSF1==0 )%>%select(Id,BsmtQual,BsmtCond,BsmtExposure,BsmtFinType1,BsmtFinType2,BsmtFullBath,BsmtHalfBath,TotalBsmtSF,BsmtFinSF1,BsmtFinSF2,BsmtUnfSF)
kable(table(prueba$BsmtFinType1,prueba$BsmtFinType2))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	Unf
Unf	851


kable(table(prueba$BsmtFinSF1,prueba$BsmtFinSF2))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	0
0	851


nrow(prueba%>%filter(prueba$BsmtUnfSF==0))
## [1] 0

Todos los registros aparecen como Unf Inacabado. Es correcto

1.4.4 GARAGE

En los inmuebles sin garaje buscamos registros que tengan campos con contradicciones o incongruencias

prueba<-total%>%filter(GarageType=='NONE' | GarageFinish=='NONE' | GarageQual=='NONE' | GarageCond== 'NONE')%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars)
nrow(prueba%>%filter(GarageType!='NONE' | GarageFinish!='NONE' | GarageQual!='NONE' | GarageCond!= 'NONE' | GarageYrBlt>0 | GarageCars>0 | GarageArea>0 )%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars))
## [1] 0

En los inmuebles con garaje buscamos registros que tengan campos con contradicciones o incongruencias

prueba<-total%>%filter(GarageType!='NONE' | GarageFinish!='NONE' | GarageQual!='NONE' | GarageCond!= 'NONE' | GarageYrBlt>0 | GarageCars>0 | GarageArea>0 )%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars)
nrow(prueba%>%filter(GarageType=='NONE' | GarageFinish=='NONE' | GarageQual=='NONE' | GarageCond== 'NONE' | GarageYrBlt==0 | GarageCars==0 | GarageArea==0)%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars))
## [1] 0

1.5 CAMBIOS EN TIPOLOGIAS

1.5.1 CATEGORICAS

Teniendo en cuenta que para el análisis con las variable independientes categóricas se crearan variables “dummy”, tantas como categorías-1 por cada variable, parece claro pensar que favorece reducir el numero de variables, reduciendo la complejidad.

En nuestro caso , y en mi opinión es posible realizarlo cambiando ciertas variables de categóricas a ordinales. Sobre todo en aquellas que tengan un orden que parezca lógico.

Para seguir un criterio razonable, he escogido la transformación creciente desde 0 hasta el numero de categorías dentro de cada variable, siempre desde menos a mas, o si se prefiere de peor a mejor, pero con la salvedad de que 0 solo se escoge para la categoría que significa que no existe esa variable.

Por simplificar con un ejemplo, puedo tener una variable que me habla de la calidad del acabado del garaje, dentro de las cuales tengo varias categorías que van desde una mala calidad a una muy buena. Evidentemente el orden es creciente con el máximo valor para la mejor de las categorías, pero el 0 se reserva solo si dentro de esas categorías me aparece una indicando que no tiene garaje

Estas son las variables categóricas que he seleccionado, y al lado la asignación que le doy a cada categoría de cada una de ellas

LotShape
forma general de la propiedad

Codigo	Tipo
Reg 4	Regular
IR1 3	Slightly irregular
IR2 2	Moderately Irregular
IR3 1	Irregular

LandSlope
Pendiente de la propiedad

Codigo	Tipo
Gtl 3	Gentle slope
Mod 2	Moderate Slope
Sev 1	Severe Slope

ExterQual
calidad del material exterior

Codigo	Tipo
Ex 5	Excellent
Gd 4	Good
TA 3	Average/Typical
Fa 2	Fair
Po 1	Poor

ExterCond
estado actual del material en el exterior

Codigo	Tipo
Ex 5	Excellent
Gd 4	Good
TA 3	Average/Typical
Fa 2	Fair
Po 1	Poor

BsmtQual
Altura del sótano

Codigo	Tipo
Ex 5	Excellent (100+ inches)
Gd 4	Good (90-99 inches)
TA 3	Typical (80-89 inches)
Fa 2	Fair (70-79 inches)
Po 1	Poor (<70 inches
NONE 0	No Basement

BsmtCond
estado general del sótano

Codigo	Tipo
Ex 5	Excellent
Gd 4	Good
TA 3	Typical - slight dampness allowed
Fa 2	Fair - dampness or some cracking or settling
Po 1	Poor - Severe cracking, settling, or wetness
NONE 0	No Basement

BsmtExposure
muros de sotano a ras de suelo o de jardín

Codigo	Tipo
Gd 4	Good Exposure
Av 3	Average Exposure (split levels or foyers typically score average or above)
Mn 2	Mimimum Exposure
No 1	No Exposure
NONE 0	No Basement

BsmtFinType1
Calidad del área acabada del sótano

Codigo	Tipo
GLQ 6	Good Living Quarters
ALQ 5	Average Living Quarters
BLQ 4	Below Average Living Quarters
Rec 3	Average Rec Room
LwQ 2	Low Quality
Unf 1	Unfinshed
NONE 0	No Basement

BsmtFinType2
Calidad del segundo área terminada (si está presente)

Codigo	Tipo
GLQ 6	Good Living Quarters
ALQ 5	Average Living Quarters
BLQ 4	Below Average Living Quarters
Rec 3	Average Rec Room
LwQ 2	Low Quality
Unf 1	Unfinshed
NONE 0	No Basement

HeatingQC
Calidad y condición de la calefacción

Codigo	Tipo
Ex 5	Excellent
Gd 4	Good
TA 3	Average/Typical
Fa 2	Fair
Po 1	Poor

KitchenQual
calidad de la cocina

Codigo	Tipo
Ex 5	Excellent
Gd 4	Good
TA 3	Average/Typical
Fa 2	Fair
Po 1	Poor

FireplaceQu
calidad de la chimenea

Codigo	Tipo
Ex 5	Excellent - Exceptional Masonry Fireplace
Gd 4	Good - Masonry Fireplace in main level
TA 3	Average - Prefabricated Fireplace in main living area or Masonry Fireplace in basement
Fa 2	Fair - Prefabricated Fireplace in basement
Po 1	Poor - Ben Franklin Stove
NONE 0	No Fireplace

GarageFinish
acabado interior del garaje

Codigo	Tipo
Fin 3	Finished
RFn 2	Rough Finished
Unf 1	Unfinished
NONE 0	No Garage

GarageQual
calidad de garaje

Codigo	Tipo
Ex 5	Excellent
Gd 4	Good
TA 3	Average/Typical
Fa 2	Fair
Po 1	Poor
NONE 0	No Garage

GarageCond
condición de garaje

Codigo	Tipo
Ex 5	Excellent
Gd 4	Good
TA 3	Average/Typical
Fa 2	Fair
Po 1	Poor
NONE 0	No Garage

PoolQC
calidad de la piscina

Codigo	Tipo
Ex 4	Excellent
Gd 3	Good
TA 2	Average/Typical
Fa 1	Fair
NONE 0	No Pool

#Guardamos los cambios y los vuelvo a abrir para que me convierta los caracteres a factor
write.csv(total,file="Total1.csv",row.names = FALSE)
total<-read.csv("Total1.csv",sep=",",header = TRUE)

Las cambiamos

total$BsmtCond<-plyr::revalue(total$BsmtCond,c('NONE'='0','Po'='1','Fa'='2','TA'='3','Gd'='4','Ex'=5))
total$BsmtExposure<-plyr::revalue(total$BsmtExposure,c('NONE'=0,'No'=1,'Mn'=2,'Av'=3,'Gd'=4))
total$BsmtFinType1<-plyr::revalue(total$BsmtFinType1,c('NONE'=0,'Unf'=1,'LwQ'=2,'Rec'=3,'BLQ'=4,'ALQ'=5,'GLQ'=6))
total$BsmtFinType2<-plyr::revalue(total$BsmtFinType2,c('NONE'=0,'Unf'=1,'LwQ'=2,'Rec'=3,'BLQ'=4,'ALQ'=5,'GLQ'=6))
total$BsmtQual<-plyr::revalue(total$BsmtQual,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))

total$ExterCond<-plyr::revalue(total$ExterCond,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))
total$ExterQual<-plyr::revalue(total$ExterQual,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))

total$FireplaceQu<-plyr::revalue(total$FireplaceQu,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))

total$GarageCond<-plyr::revalue(total$GarageCond,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))
total$GarageFinish<-plyr::revalue(total$GarageFinish,c('NONE'=0,'Unf'=1,'RFn'=2,'Fin'=3))
total$GarageQual<-plyr::revalue(total$GarageQual,c('NONE'=0,'Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))

total$HeatingQC<-plyr::revalue(total$HeatingQC,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))

total$KitchenQual<-plyr::revalue(total$KitchenQual,c('Po'=1,'Fa'=2,'TA'=3,'Gd'=4,'Ex'=5))

total$LandSlope<-plyr::revalue(total$LandSlope,c('Sev'=1,'Mod'=2,'Gtl'=3))

total$LotShape<-plyr::revalue(total$LotShape,c('IR3'=1,'IR2'=2,'IR1'=3,'Reg'=4))

total$PoolQC<-plyr::revalue(total$PoolQC,c('NONE'=0,'Fa'=1,'TA'=2,'Gd'=3,'Ex'=4))

total$BsmtCond<-as.numeric(levels(total$BsmtCond))[total$BsmtCond]
total$BsmtExposure<-as.numeric(levels(total$BsmtExposure))[total$BsmtExposure]
total$BsmtFinType1<-as.numeric(levels(total$BsmtFinType1))[total$BsmtFinType1]
total$BsmtFinType2<-as.numeric(levels(total$BsmtFinType2))[total$BsmtFinType2]
total$BsmtQual<-as.numeric(levels(total$BsmtQual))[total$BsmtQual]
total$ExterCond<-as.numeric(levels(total$ExterCond))[total$ExterCond]
total$ExterQual<-as.numeric(levels(total$ExterQual))[total$ExterQual]
total$FireplaceQu<-as.numeric(levels(total$FireplaceQu))[total$FireplaceQu]
total$GarageCond<-as.numeric(levels(total$GarageCond))[total$GarageCond]
total$GarageFinish<-as.numeric(levels(total$GarageFinish))[total$GarageFinish]
total$GarageQual<-as.numeric(levels(total$GarageQual))[total$GarageQual]
total$HeatingQC<-as.numeric(levels(total$HeatingQC))[total$HeatingQC]
total$KitchenQual<-as.numeric(levels(total$KitchenQual))[total$KitchenQual]
total$LandSlope<-as.numeric(levels(total$LandSlope))[total$LandSlope]
total$LotShape<-as.numeric(levels(total$LotShape))[total$LotShape]
total$PoolQC<-as.numeric(levels(total$PoolQC))[total$PoolQC]

1.5.2 ORDINALES

Vamos a revisar las variables que ya teníamos como ordinales en los datos originales

Mientras que OverallQual y OverallCond no ofrecen ninguna duda, MSSubclass me parece que no esta correctamente planteada.

Puede que se usara ese código numerico para identificar mejor las distintas clases de edificación pero no tiene una relación ordinal

Se puede apreciar en este grafico con la relación que tiene con el precio

Revision de las ordinales originales

Train<-total%>%filter(is.na(SalePrice)==FALSE)
PlotClas<-ggplot()
PlotClas<-PlotClas+geom_col(data=Train,aes(x=Train$MSSubClass,y=Train$SalePrice),fill="lightblue")
PlotClas<-PlotClas+labs(x="Clases",y="Precios")
PlotClas

Cambiamos de ordinal a categorica

Cod<-c('20'='1-STORY 1946 & NEWER ALL STYLES','30'='1-STORY 1945 & OLDER','40'='1-STORY W/FINISHED ATTIC ALL AGES','45'='1-1/2 STORY - UNFINISHED ALL AGES','50'='1-1/2 STORY FINISHED ALL AGES','60'='2-STORY 1946 & NEWER','70'='2-STORY 1945 & OLDER','75'='2-1/2 STORY ALL AGES','80'='SPLIT OR MULTI-LEVEL','85'='SPLIT FOYER','90'='DUPLEX - ALL STYLES AND AGES','120'='1-STORY PUD (Planned Unit Development) - 1946 & NEWER','150'='1-1/2 STORY PUD - ALL AGES','160'='2-STORY PUD - 1946 & NEWER','180'='PUD - MULTILEVEL - INCL SPLIT LEV/FOYER','190'='2 FAMILY CONVERSION - ALL STYLES AND AGES')
total$MSSubClass<-as.factor(total$MSSubClass)
total$MSSubClass<-plyr::revalue(total$MSSubClass,Cod)

1.5.3 CUANTITATIVAS

En el caso de variables cuantitativas originalmente en el dataset , vamos a revisar aquellas que no tengan justificación como numericas

#Columnas con valores numericos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

Antes de empezar voy a revisar la normalidad de las variables cuantitativas para lo cual he creado un pequeño codigo

#Preparar datos
options(digits=18)
normal<-data.frame()
for (i in 1:length(TrainNum)){
  normal[i,1]<-colnames(TrainNum[i])
  normal[i,2]<-shapiro.test(TrainNum[,i])[[2]]
  if (normal[i,2]<0.05) {
    normal[i,3]<-'NO'
  }else {
    normal[i,3]<-'SI'
  }
  
}
colnames(normal)<-c('Variable','p-value')
#Numero de variables normales(SI o NO)
table(normal[,3])
## 
## NO 
## 53

El resultado es que ninguna de las 53 variables numéricas tienen normalidad. Esto me sirve para seleccionar el método de correlacion de Spearman

Vemos las variables cuantitativas susceptibles de cambiarse a categoricas

En principio voy a revisar aquellas cuya cantidad represente algo en si misma, y en esta categoría entran todo lo referido a fechas. Repasando una por una

1.5.3.1 MOSOLD (Mes venta)

Vemos como se distribuye

options(digits=6)
mes1<-ggplot()
mes1<-mes1+geom_bar(data=TotalNum,aes(x=TotalNum$MoSold),fill='blue',position = 'stack')
mes1<-mes1+geom_bar(data=TrainNum,aes(x=TrainNum$MoSold),fill='red',position = 'stack')
mes1<-mes1+labs(x='MESES',y='CANTIDAD')+scale_x_continuous(breaks = pretty(TrainNum$MoSold,n=12))
mes1

En azul el total de viviendas, y por encima en rojo solo el conjunto de entrenamiento.

No parece que haya excesivas diferencias y en la mayoría de los meses se aprecia visualmente que el conjunto de entrenamiento representa la mitad del total.

Podemos apreciar que la numeración se refiere evidentemente a los meses y refleja una distribución en la venta superior en los meses de Mayo, Junio y Julio.

Veamos si eso afecta a el precio de venta en el conjunto Train

mes<-ggplot(data=TrainNum,aes(x=TrainNum$MoSold,y=TrainNum$SalePrice))
mes<-mes+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
mes<-mes+geom_bar(stat="summary",fun.y="mean",fill="royalblue")
mes<-mes+labs(x='MESES',y='PRECIO MEDIO')+scale_x_continuous(breaks = pretty(TrainNum$MoSold,n=12))
mes<-mes+scale_y_continuous(labels = scales::comma)
mes

El precio medio es parecido y no se ve relación con el mes (entre parentesis aparece la cantidad)

mes2<-ggplot()
mes2<-mes2+geom_boxplot(data=TrainNum,aes(x=TrainNum$MoSold,y=TrainNum$SalePrice,group=TrainNum$MoSold))
mes2<-mes2+labs(x='MESES',y='PRECIO ')+scale_x_continuous(breaks = pretty(TrainNum$MoSold,n=12))
mes2<-mes2+scale_y_continuous(labels = scales::comma)
mes2

Vemos correlacion

cor(x=TrainNum$MoSold,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.0694322

En mi opinión con esa correlacion tan próxima a 0 no influye para nada en el precio

1.5.3.2 YRSOLD (Año venta)

Tenemos un total de cuatro años. Veamoslo gráficamente al igual que con los meses

year1<-ggplot()
year1<-year1+geom_bar(data=TotalNum,aes(x=TotalNum$YrSold),fill='blue',position = 'stack')
year1<-year1+geom_bar(data=TrainNum,aes(x=TrainNum$YrSold),fill='red',position = 'stack')
year1<-year1+labs(x='AÑOS',y='CANTIDAD')+scale_x_continuous(breaks = pretty(TrainNum$YrSold,n=5))
year1

year<-ggplot(data=TrainNum,aes(x=TrainNum$YrSold,y=TrainNum$SalePrice))
year<-year+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
year<-year+geom_bar(stat="summary",fun.y="mean",fill="royalblue")
year<-year+labs(x='AÑOS',y='PRECIO MEDIO')+scale_x_continuous(breaks = pretty(TrainNum$YrSold,n=5))
year<-year+scale_y_continuous(labels = scales::comma)
year

year2<-ggplot()
year2<-year2+geom_boxplot(data=TrainNum,aes(x=TrainNum$YrSold,y=TrainNum$SalePrice,group=TrainNum$YrSold))
year2<-year2+labs(x='AÑOS',y='PRECIO')+scale_x_continuous(breaks = pretty(TrainNum$YrSold,n=5))
year2<-year2+scale_y_continuous(labels = scales::comma)
year2

Vemos correlacion

cor(x=TrainNum$YrSold,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
## [1] -0.0298991

Tiene la particularidad de que nos puede servir para considerar la antigüedad de la vivienda y ahí puede ser relevante que sea numérico. Voy a posponerlo para mas adelante cuando veamos el año de construcción y el de remodelación

1.5.3.3 YearBuilt YearRemodAdd (Año de construccion y Año de remodelacion)

Vemos estas dos variables puesto que están muy relacionadas.

La primera no necesita explicación, en cuanto a la segunda es el año en que la vivienda ha sufrido algún tipo de remodelación.

Si no ha tenido ninguna esta se corresponde con la fecha de construcción

Vamos a ver gráficamente la posible relación con el precio de venta

built<-ggplot()
built<-built+geom_point(data=TrainNum,aes(x=TrainNum$YearBuilt,y=TrainNum$SalePrice),color='blue')
built<-built+labs(x='AÑOS',y='PRECIO',title='CONSTRUCCION')+scale_y_continuous(labels = scales::comma)
built

Vemos ahora para el año de remodelación

built1<-ggplot()
built1<-built1+geom_point(data=TrainNum,aes(x=TrainNum$YearRemodAdd,y=TrainNum$SalePrice),color='red')
built1<-built1+labs(x='AÑOS',y='PRECIO',title= 'REMODELACION')+scale_y_continuous(labels = scales::comma)
built1

Tiene la peculiaridad de que computa a partir de 1950, y en ese año tiene un numero extraordinario de casos, 178 en el Train y 361 en el total, seguramente porque se empezaría a computar ese año y todas las que tienen una antigüedad mayor se computan aqui

Parece razonable pensar a la vista de las graficas que existe algún tipo de relación con el precio de venta. Numericamente:

#Correlacion año construccion
cor(x=TrainNum$YearBuilt,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")
## [1] 0.652682
#Correlacion año remodelacion
cor(x=TrainNum$YearRemodAdd,y=TrainNum$SalePrice,method = "spearman",use="na.or.complete")
## [1] 0.571159

¿Que pasaria si distinguimos aquellas casas que han sido remodeladas , y por lo tanto su fecha de remodelacion es diferente a la de construccion, de aquellas que no lo han sido?

Prueba de remodelacion. Creamos una columna. No remodelados=0. Remodelados=1

TrainNum$Remodelado<-0
TrainNum$Remodelado[TrainNum$YearBuilt!=TrainNum$YearRemodAdd]<-1
#Dividimos el dataset
T1<-TrainNum%>%filter(Remodelado==1)
T0<-TrainNum%>%filter(Remodelado==0)

#Calculamos correlacion para remodelados
#Correlacion año construccion
cor(x=T1$YearBuilt,y=T1$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.643186
#Correlacion año remodelacion
cor(x=T1$YearRemodAdd,y=T1$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.478056

#No remodelados
cor(x=T0$YearBuilt,y=T0$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.680097

Esta claro que importa el año de construccion, importa el año de remodelacion, importa si estan o no remodeladas en cuanto afecta a su antigüedad y además tenemos unos valores extraños en 1950 que debemos corregir.

Voy a considerar que ninguna de esas viviendas han sido remodeladas por lo que aplicare a esa variable, la del año de construcción

Aplico a la remodelacion de los de 1950 el año de construccion

total$YearRemodAdd[total$YearRemodAdd<1951]<-total$YearBuilt[total$YearRemodAdd<1951]
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Vuelvo a comprobar correlacion
TrainNum$Remodelado<-0
TrainNum$Remodelado[TrainNum$YearBuilt!=TrainNum$YearRemodAdd]<-1
#Dividimos el dataset
T1<-TrainNum%>%filter(Remodelado==1)
T0<-TrainNum%>%filter(Remodelado==0)
#Calculamos correlacion para remodelados
#Correlacion año construccion
cor(x=T1$YearBuilt,y=T1$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.613344
#Correlacion año remodelacion
cor(x=T1$YearRemodAdd,y=T1$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.229517
#No remodelados
cor(x=T0$YearBuilt,y=T0$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.708576

built3<-ggplot()
built3<-built3+geom_point(data=TrainNum,aes(x=TrainNum$YearBuilt,y=TrainNum$SalePrice,color=Remodelado))
built3<-built3+facet_grid(Remodelado~.,labeller = label_both)+theme(legend.position = 'none')
built3<-built3+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION VIVIENDAS')+scale_y_continuous(labels = scales::comma)
built3

Vamos a afinar un poco mas calculando la antigüedad respecto al año de venta. Creamos una columna nueva:

Calculo antiguedad completa

total$Antiguedad<-total$YrSold-total$YearBuilt
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Buscamos errores
kable(TotalNum%>%filter(Antiguedad<0)%>%select(Id,YearBuilt,YrSold))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	YearBuilt	YrSold
2550	2008	2007

Existe un registro con año venta anterior al de la construccion. Lo igualo

total[2550,78]<-2008
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

Busco errores también en el año de remodelación

Revision de incongruencia de datos con YearRemodAdd

kable(TotalNum%>%filter((TotalNum$YrSold-TotalNum$YearRemodAdd)<0)%>%select(Id,YrSold,YearBuilt,YearRemodAdd))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	YrSold	YearBuilt	YearRemodAdd
524	2007	2007	2008
2296	2007	2007	2008
2550	2008	2008	2009

Corrijo los valores al año de venta

total[524,21]<-2007
total[2296,21]<-2007
total[2550,21]<-2008

Mas incongruencias

kable(TotalNum%>%filter((TotalNum$YearBuilt-TotalNum$YearRemodAdd)>0)%>%select(Id,YrSold,YearBuilt,YearRemodAdd))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	YrSold	YearBuilt	YearRemodAdd
1877	2009	2002	2001

Corrijo los valores al año de construccion

total[1877,21]<-2002

Volvemos a calcular y actualizar

total$Antiguedad<-total$YrSold-total$YearBuilt
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Vuelvo a comprobar correlacion
TrainNum$Remodelado<-0
TrainNum$Remodelado[TrainNum$YearBuilt!=TrainNum$YearRemodAdd]<-1
#Dividimos el dataset
T1<-TrainNum%>%filter(Remodelado==1)
T0<-TrainNum%>%filter(Remodelado==0)
#Calculamos correlacion para remodelados
cor(x=T1$Antiguedad,y=T1$SalePrice,method="spearman",use="na.or.complete")
## [1] -0.612723
#No remodelados
cor(x=T0$Antiguedad,y=T0$SalePrice,method="spearman",use="na.or.complete")
## [1] -0.706995

built4<-ggplot()
built4<-built4+geom_point(data=TrainNum,aes(x=TrainNum$Antiguedad,y=TrainNum$SalePrice,color=Remodelado))
built4<-built4+facet_grid(Remodelado~.,labeller = label_both)+theme(legend.position = 'none')
built4<-built4+labs(x='AÑOS',y='PRECIO',title='ANTIGUEDAD VIVIENDAS')+scale_y_continuous(labels = scales::comma)
built4

Los valores son parecidos pero al calcular sobre el numero de años se invierte el signo

En conclusión, la antigüedad de la vivienda tiene una relación fuerte con el precio de venta, y además el hecho de ser una vivienda remodelada o no tambien es importante.

Le afecta menos cuando se ha realizado dicha remodelación.

Por lo cual calculamos la antigüedad (ya realizado), calculamos si hay o no remodelación

#Conclusiones
total$Remodelado<-0
total$Remodelado[total$YearBuilt!=total$YearRemodAdd]<-1
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]

Si calculamos la correlacion de la antiguedad respecto al precio tenemos un valor -0.65012.

Hemos visto que los remodelados tienen -0.612723 y los no remodelados -0.706995 lo que significa que están penalizados por el calculo conjunto.

Podriamos pensar que si tomamos la antigüedad como la diferencia entre el año de venta y el de remodelación(teniendo en cuenta que para las viviendas no remodeladas este es igual que el de construcción) obtendríamos una variable mas adecuada, pero es al contrario , el valor de la correlacion es -0.575787.

Hay que encontrar una manera de penalizar a las viviendas remodeladas en su antigüedad

Mi propuesta es penalizar a las viviendas que han sido remodeladas aumentando su antigüedad de manera artificial.

Proporcionalmente al tiempo que se ha tardado en remodelar. ¿Cuánto?. La decima porcentual que tienen de diferencia las correlaciones.

#Penalizacion
TotalNum.remo<-TotalNum%>%filter(Remodelado==1)
summary(TotalNum.remo$YearRemodAdd-TotalNum.remo$YearBuilt)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     1.0     1.0    20.0    29.9    52.0   127.0

Creo una columna donde pongo este calculo

Como la antiguedad la tenemos en enteros y para ser justo con la penalizacion voy a normalizar las variables

Luego le aplicare un 10% de la antigüedad de la remodelación a la antigüedad de la vivienda

total$Penaliza<-total$YearRemodAdd-total$YearBuilt
#Normalizo
total$Antiguedad<-normalize(total$Antiguedad)
total$Penaliza<-normalize(total$Penaliza)
#Penalizo
total$Antiguedad<-total$Antiguedad+total$Penaliza*0.1
#Borro las variables auxiliares Remodelado y Penaliza
total$Remodelado<-NULL
total$Penaliza<-NULL
#Recargamos los datos
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

1.5.3.4 GarageYrBuilt (Año en el que fue construido el garage)

Eliminamos los valores igual a 0, o sea que no tienen garaje. Ya comprobamos anteriormente la congruencia de los registros

Vemos gráficamente

GarageTOTAno<-TotalNum%>%filter(GarageYrBlt!=0)
garage<-ggplot(data=GarageTOTAno,aes(x=GarageTOTAno$GarageYrBlt))
garage<-garage+geom_histogram(fill='blue')
garage<-garage+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma)
garage
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Tenemos un outlier. Corresponde al registro 2593. Vamos a ver los datos pertinentes

kable(total%>%filter(Id==2593)%>%select(Id,GarageType,GarageYrBlt,GarageFinish,GarageQual,GarageArea,GarageCond,GarageCars,YearBuilt,YearRemodAdd,YrSold))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	GarageType	GarageYrBlt	GarageFinish	GarageQual	GarageArea	GarageCond	GarageCars	YearBuilt	YearRemodAdd	YrSold
2593	Attchd	2207	2	3	502	3	2	2006	2007	2007

Podemos inferir que el año real de construcción del garaje es 2007. Modificamos

total[2593,60]<-2007

Recalculamos y volvemos a observar

#Recalcular
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
#Visualizacion total 
GarageTOTAno<-TotalNum%>%filter(GarageYrBlt!=0)
garage<-ggplot(data=GarageTOTAno,aes(x=GarageTOTAno$GarageYrBlt))
garage<-garage+geom_histogram(fill='blue')
garage<-garage+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma)
garage
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Verifico que el año de construcción del Garage sea posterior al de la casa

GarageTOTAno$dif<-GarageTOTAno$GarageYrBlt-GarageTOTAno$YearBuilt
kable(GarageTOTAno%>%filter(dif<0)%>%select(Id,YearBuilt,GarageYrBlt))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	YearBuilt	GarageYrBlt
30	1927	1920
94	1910	1900
325	1967	1961
601	2005	2003
737	1950	1949
1104	1959	1954
1377	1930	1925
1415	1923	1922
1419	1963	1962
1522	1959	1956
1577	2010	2009
1806	1935	1920
1841	1978	1960
1896	1941	1940
1898	1935	1926
2123	1945	1925
2264	2006	2005
2510	2006	2005

Hay 18 registros que tienen el año de construccion del garage anterior al de la vivienda. Entiendo que se debe a errores tipográficos, como confundir un 4 por un 9 o diferencias pequeñas de tiempo que hacen variar en un año

Ponemos el año como el de la vivienda

total$GarageYrBlt[(total$GarageYrBlt<total$YearBuilt)&(total$GarageYrBlt!=0)]<-total$YearBuilt[(total$GarageYrBlt<total$YearBuilt)&(total$GarageYrBlt!=0)]

#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

Veamos la relación con el precio

#Visualizar train. Eliminamos los que no tienen garaje
GarageAno<-TrainNum%>%filter(GarageYrBlt!=0)

garage1<-ggplot()
garage1<-garage1+geom_point(data=GarageAno,aes(x=GarageAno$GarageYrBlt,y=GarageAno$SalePrice))
garage1<-garage1+labs(x='AÑOS',y='PRECIO',title='AÑO CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma)
garage1

Parece existir una relación. Numericamente

cor(x=GarageAno$GarageYrBlt,y=GarageAno$SalePrice,method="spearman",use="na.or.complete")
## [1] 0.594246

Hay que tener en cuenta que no he incluido los registros que no tienen garaje.

Si se les incluye, curiosamente la correlacion aumenta.

De todas formas es interesante realizar como con la variable anterior, calcular la antigüedad

#Calculo antiguedad Garaje
total$AntGarage<-total$YrSold-total$GarageYrBlt
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

#Correlacion
cor(x=TrainNum$AntGarage,y=TrainNum$SalePrice,method="spearman",use="na.or.complete")
## [1] -0.63301

garage2<-ggplot()
garage2<-garage2+geom_point(data=TrainNum,aes(x=TrainNum$AntGarage,y=TrainNum$SalePrice))
garage2<-garage2+labs(x='AÑOS',y='PRECIO',title='ANTIGUEDAD CONSTRUCCION GARAGE')+scale_y_continuous(labels = scales::comma)
garage2

En conclusion para las variables YearBuilt, YearRemodAdd, MoSold, YrSold y GarageYrBlt nos quedamos con Antigüedad y AntGarage como variables importantes para el precio de venta

1.5.3.5 REVISION RESTO CUANTITATIVAS (Sin relacion con fechas)

Vemos a continuacion el resto de variables cuantitativas y relación entre ellas para poder ver si reducimos su numero.

Voy a crear una matriz de correlaciones entre estas variables sin contar en principio con el precio.

Para saber si existe una dependencia entre algunas de ellas que nos pueda servir.

Para eso uso el paquete corrplot

Primero la correlacion de las variables entre si, sin contar con el precio ni las variables ya tratadas

TotalNum.noprice<-TotalNum%>%select(-Id,-SalePrice,-YearBuilt,-YearRemodAdd,-MoSold,-YrSold,-GarageYrBlt )

#Matriz correlaciones
CorrNum<-cor(TotalNum.noprice,method = 'spearman')
#Valores absolutos
CorrNum.abs<-as.data.frame(abs(CorrNum))              
#Pongo a 0 los 1 para encontrar el maximo
CorrNum.abs[which(CorrNum.abs==1,arr.ind = TRUE)]<-0  
#Busco el valor maximo de correlacion en cada variable ahora 
CorrNum.inf<-apply(CorrNum.abs,2,max)                 
#Elimino las filas y columnas con correlacion baja
CorrNum.max<-CorrNum.abs[-(which(CorrNum.inf<0.5)),-(which(CorrNum.inf<0.5))]
#Pongo a 0 los valores inferiores a 0.5
CorrNum.max[which(CorrNum.max<0.5,arr.ind = TRUE)]<-0  
CorrNum.max<-as.matrix(CorrNum.max)

corrplot(CorrNum.max,order = 'hclust',hclust.method = 'ward.D2',sig.level = 0.5,tl.col = 'black',tl.cex = 0.8,tl.srt = 45,addrect = 14,diag = FALSE)

Se ve claramente dependencia en ciertos grupos de variables.

Antes de seguir vamos a ver la correlacion de las variable significativas (superior a 0.5 en términos absolutos) respecto al Precio

#CORRELACION CON PRECIO
TrainNum.price<-TrainNum%>%select(-Id,-YearBuilt,-YearRemodAdd,-MoSold,-YrSold,-GarageYrBlt )
#Matriz correlaciones
CorrPri<-cor(TrainNum.price,method = 'spearman')                        
CorrPri.abs<-as.data.frame(CorrPri)     
#Pongo a 0 los 1 para encontrar el maximo
CorrPri.abs[which(CorrPri.abs==1,arr.ind = TRUE)]<-0  
#Busco el valor maximo de correlacion en cada variable ahora 
CorrPri.inf<-apply(CorrPri.abs,2,max)      
#Busco el valor minimo de correlacion en cada variable ahora 
CorrPri.sup<-apply(CorrPri.abs,2,min)                 
#Elimino las filas y columnas con correlacion baja
CorrPri.max<-CorrPri.abs[-(which(CorrPri.inf<0.5 & CorrPri.sup>-0.5)),-(which(CorrPri.inf<0.5 & CorrPri.sup>-0.5))]  
#Pongo a 0 los valores inferiores a 0.5 y superiores a -0.5
CorrPri.max[which((CorrPri.max<0.5 & CorrPri.max>-0.5),arr.ind = TRUE)]<-0  
CorrPri.max<-as.matrix(CorrPri.max)
#Reordenamos por FPC
Orden.fpc<-corrMatOrder(CorrPri.max,order='FPC')    #Primer Componente principal
CorrNum.fpc<-CorrPri.max[Orden.fpc,Orden.fpc]
#Grafico
corrplot(CorrNum.fpc,type='lower',tl.col = 'black',tl.cex = .8,tl.srt = 30)

En el grafico en la fila inferior tenemos SalePrice.

En rojo las variables con correlacion negativa :

 AntGarage    Antigüedad

En azul las variables predictoras con correlacion positiva:

 GarageArea      GarageCars

 Fireplaces    FireplaceQu

 X1stFlrSF     TotalBsmtSF

 TotRmsAbvGrd  GrLivArea   FullBath

 GarageFinish

 KitchenQual

 BsmtQual

 ExterQual

 OverallQual

Las variables que pongo juntas tienen una correlacion fuerte (ver primer grafico ) entre ellas y cierta explicacion lógica. Las vere a continuación por si se puede reducir el numero de variables predictoras

1.5.3.5.1 ANTIGUEDAD y ANTGARAGE

Es evidente que tiene una gran correlacion porque en cierta medida su valor crece de manera proporcionada.

Si una vivienda tiene un garaje, la antigüedad del garaje crece de igual manera que la antigüedad de la vivienda y suelen ser iguales salvo que el garaje se haya construido después.

De todas formas no soy partidario de unirlas de alguna forma porque la variable AntGarage tiene la peculiaridad de aquellas viviendas sin garaje que hay que mantener

Solo voy a normalizar la varable AntGarage, puesto que Antigüedad ya lo estaba

total$AntGarage<-normalize(total$AntGarage)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

1.5.3.5.2 GARAGECARS Y GARAGEAREA

A pesar de que tienen relación con otras variables la mas importante es entre ellos, y puede parecer lógico puesto que el numero de coches que pueda entrar en un garaje depende directamente del espacio que este tenga

Primero normalizo las variables según función

TotalNum$GarageArea<-normalize(TotalNum$GarageArea)
TotalNum$GarageCars<-normalize(TotalNum$GarageCars)
cor(x=TotalNum$GarageArea,y=TotalNum$GarageCars,method = 'spearman')
## [1] 0.864929

La relacion es positiva. Ambas tienen una correlacion positiva y parecida con respecto al precio

TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

cor(x=TrainNum$GarageArea,y=TrainNum$SalePrice,method = 'spearman')
## [1] 0.649379
cor(x=TrainNum$GarageCars,y=TrainNum$SalePrice,method = 'spearman')
## [1] 0.690711

La opcion que opto es multiplicar ambas variables puesto que GarageCars es discreta y GarageArea es continua.

La nueva variable se convierte en continua, mantiene la normalización y el valor 0 para los que no tienen garaje

TrainNum$Garage2<-TrainNum$GarageArea*TrainNum$GarageCars
cor(x=TrainNum$Garage2,y=TrainNum$SalePrice,method = 'spearman')
## [1] 0.668591

Es una correlacion media de las otras dos

total$GarageTotal<-normalize(total$GarageArea)*normalize(total$GarageCars)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

1.5.3.5.3 FIREPLACES y FIREPLACEQU

Fireplaces es el numero de chimeneas

FireplacesQu es la calidad según vimos cuando se paso de categorica a ordinal

La correlacion positiva entre ellas nos indica que a medida que el numero de chimeneas aumenta también aumenta la calidad

cor(x=total$Fireplaces,y=total$FireplaceQu,method = 'kendall')
## [1] 0.820617

Ademas es una relacion fuerte. v Vemos un grafico

chim<-ggplot(data=TotalNum,aes(x=TotalNum$Fireplaces, y=TotalNum$FireplaceQu))
chim<-chim+geom_count()+labs(x="NUMERO",y="CALIDAD")
chim

Con respecto al precio

cor(x=TrainNum$FireplaceQu,y=TrainNum$SalePrice,method='spearman')
## [1] 0.537602
cor(x=TrainNum$Fireplaces,y=TrainNum$SalePrice,method='spearman')
## [1] 0.519247

La correlacion con el precio no es muy alta y ademas la correlacion entre ellas es altisima, por lo que me quedo con una y descarto la otra

Me quedo con FireplaceQu . La normalizo

total$FireplaceQu<-normalize(total$FireplaceQu)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

1.5.3.5.4 1STFlRSF y TOTALBSMTSF

1stFlrSF corresponde al área del primer piso.

TotalBsmtSF es el área del sotano

La correlacion entre ellos es bastante alta

cor(x=total$X1stFlrSF,y=total$TotalBsmtSF,method='spearman')
## [1] 0.828737

Se presupone que las viviendas que tienen sotano , por lo general el área en planta del sotano es igual que el de la primera planta.

La diferencia por lo general esta en que todas las viviendas tienen primera planta, pero no todas tienen sotano

summary(total$X1stFlrSF)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##     334     876    1082    1160    1388    5095
summary(total$TotalBsmtSF)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       0     793     989    1051    1302    6110

Vemos un grafico esclarecedor

pru<-ggplot()
pru<-pru+geom_point(data=TotalNum,aes(x=TotalNum$X1stFlrSF,y=TotalNum$TotalBsmtSF))
pru<-pru+scale_x_continuous(limits=c(0,6150))+scale_y_continuous(limits=c(0,6150))
pru<-pru+labs(x='AREA PRIMER PISO',y='AREA SOTANO')
pru

Se aprecian dos líneas claramente, una siguiendo el eje de abscisas en o que son las viviendas sin sotano y la otra línea de inclinación 45º que son las viviendas que tienen el mismo área de vivienda que de sotano.

Hay que destacar que hay unas cuantas viviendas que tienen mas área de sotano que de primer piso

Vemos su correlacion con el precio

cor(x=TrainNum$X1stFlrSF,y=TrainNum$SalePrice,method='spearman')
## [1] 0.575408
cor(x=TrainNum$TotalBsmtSF,y=TrainNum$SalePrice,method='spearman')
## [1] 0.602725

No parece que haya una correlacion muy alta . Lo vemos gráficamente

pru<-ggplot()
pru<-pru+geom_point(data=TrainNum,aes(x=TrainNum$X1stFlrSF,y=TrainNum$SalePrice),color='red')
pru<-pru+geom_point(data=TrainNum,aes(x=TrainNum$TotalBsmtSF,y=TrainNum$SalePrice),color='blue')
pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru

Tenemos dos outliers en la esquina inferior derecha. Les busco

kable(TrainNum%>%filter(X1stFlrSF>3000 & SalePrice<200000)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	X1stFlrSF	TotalBsmtSF	SalePrice
524	3138	3138	184750
1299	4692	6110	160000

Excluyo estos valores para ver si mejora

TrainNum.piso<-TrainNum%>%filter(Id!=524)%>%filter(Id!=1299)

pru<-ggplot()
pru<-pru+geom_point(data=TrainNum.piso,aes(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice),color='red')
pru<-pru+geom_point(data=TrainNum.piso,aes(x=TrainNum.piso$TotalBsmtSF,y=TrainNum.piso$SalePrice),color='blue')
pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru

El grafico parece que ha mejorado. Veamos numéricamente

cor(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice,method='spearman')
## [1] 0.576221
cor(x=TrainNum.piso$TotalBsmtSF,y=TrainNum.piso$SalePrice,method='spearman')
## [1] 0.603604

Sí hay mejoria pero no parece significativa.

En principio no descarto estos registros por si afectan a otras variables

Voy a separar en la variable de área de primera planta a las viviendas que tienen sotano y las que no

#Separo las viviendas por el sotano
TrainNum.sot<-TrainNum%>%filter(TotalBsmtSF==0)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice)
TrainNum.piso<-TrainNum%>%filter(TotalBsmtSF>0)%>%select(Id,X1stFlrSF,TotalBsmtSF,SalePrice)

Vemos graficamente

pru<-ggplot()
pru<-pru+geom_point(data=TrainNum.piso,aes(x=TrainNum.piso$X1stFlrSF,y=TrainNum.piso$SalePrice),color='blue',alpha=0.1)
pru<-pru+geom_point(data=TrainNum.sot,aes(x=TrainNum.sot$X1stFlrSF,y=TrainNum.sot$SalePrice),color='red',alpha=0.3)
pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru

Se aprecia que las vivendas sin sotano (puntos rojos) están penalizadas en el precio, están en la parte baja de la nube.

En mi opinión se debería combinar ambas variables pero que penalizen a las viviendas sin sotano, parecido a lo que sucedia a la penalizacion en la antigüedad.

Para eso voy a sumar el área del sotano y el de la primera planta

La mayoría de las viviendas verán casi doblada su superficie, pero las viviendas sin sotano se quedan como están

TrainNum$AreaPiso<-TrainNum$X1stFlrSF+TrainNum$TotalBsmtSF

Vemos graficamente

pru<-ggplot()
pru<-pru+geom_point(data=TrainNum,aes(x=TrainNum$AreaPiso,y=TrainNum$SalePrice),color='blue',alpha=0.2)
pru<-pru+labs(x='AREAS ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru

La correlacion mejora

cor(x=TrainNum$AreaPiso,y=TrainNum$SalePrice,method='spearman')
## [1] 0.623865

La distribución parece bastante parecida.

Dejamos asi la nueva variable y la normalizamos

total$AreaPiso<-normalize(total$X1stFlrSF+total$TotalBsmtSF)
#Recalculo
NNum<-which(sapply(total,is.numeric))
TotalNum<-total[,NNum]
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)

1.5.3.5.5 GRLIVAREA FULLBATH TOTRMSABVGRD

Estas variables corresponde a

 GrLivArea   pies cuadrados del área habitable sobre el nivel del suelo            FullBath  baños completos por encima del suelo          TotRmsAbvGrd  Total de habitaciones por encima del suelo (no incluye baños)

Parece evidente una relación lógica entre la primera variable y las otras dos

kable(cor(total%>%select(GrLivArea,FullBath,TotRmsAbvGrd),method='spearman'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	GrLivArea	FullBath	TotRmsAbvGrd
GrLivArea	1.000000	0.662752	0.808775
FullBath	0.662752	1.000000	0.536076
TotRmsAbvGrd	0.808775	0.536076	1.000000

Graficamente

pru<-ggplot()
pru<-pru+geom_point(data=TotalNum,aes(x=TotalNum$TotRmsAbvGrd,y=TotalNum$GrLivArea),color='blue',alpha=0.1)
pru<-pru+geom_point(data=TotalNum,aes(x=TotalNum$FullBath,y=TotalNum$GrLivArea),color='red',alpha=0.3)
pru<-pru+labs(x='Estancias ',y='Area')+scale_y_continuous(labels = scales::comma)
pru

Tenemos dos outliers que con un area habitable superior a 5000 y con 12 y 15 habitaciones solo tiene 2 baños

TotalNum.sala<-TotalNum
kable(TotalNum%>%filter(FullBath==2 & GrLivArea>5000)%>%select(Id,GrLivArea,FullBath,TotRmsAbvGrd))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	GrLivArea	FullBath	TotRmsAbvGrd
1299	5642	2	12
2550	5095	2	15

Les descarto y compruebo como queda la matriz de correlacion

TotalNum.sala<-TotalNum.sala%>%filter(Id!=1299)%>%filter(Id!=2550)
kable(cor(TotalNum.sala%>%select(GrLivArea,FullBath,TotRmsAbvGrd),method='spearman'))

	GrLivArea	FullBath	TotRmsAbvGrd
GrLivArea	1.000000	0.662584	0.808373
FullBath	0.662584	1.000000	0.535749
TotRmsAbvGrd	0.808373	0.535749	1.000000

Parece que incluso ha empeorado

Pero voy a verlo teniendo en cuenta el precio

TrainNum.sala<-TotalNum.sala%>%filter(is.na(SalePrice)==FALSE)

#Correlacion con outliers
kable(cor(TrainNum%>%select(GrLivArea,FullBath,TotRmsAbvGrd,SalePrice),method='spearman'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	GrLivArea	FullBath	TotRmsAbvGrd	SalePrice
GrLivArea	1.000000	0.658419	0.827874	0.731310
FullBath	0.658419	1.000000	0.558665	0.635957
TotRmsAbvGrd	0.827874	0.558665	1.000000	0.532586
SalePrice	0.731310	0.635957	0.532586	1.000000


#Correlacion sin outliers
kable(cor(TrainNum.sala%>%select(GrLivArea,FullBath,TotRmsAbvGrd,SalePrice),method='spearman'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	GrLivArea	FullBath	TotRmsAbvGrd	SalePrice
GrLivArea	1.000000	0.658246	0.827514	0.732112
FullBath	0.658246	1.000000	0.558364	0.636043
TotRmsAbvGrd	0.827514	0.558364	1.000000	0.533215
SalePrice	0.732112	0.636043	0.533215	1.000000

Se puede observar como al quitar los outliers la correlacion entre las variables que estudiamos empeoran pero mejoran todas con respecto al precio.

Lo dejamos en recordatorio como los otros que hemos visto para más adelante

Podemos pensar que si consideramos los baños como una estancia mas podemos unirlo en una sola variable

Pregunta: ¿Qué significa que haya viviendas que no tengan baño?

#Si se suman los baños y las estancias
#¿No tienen baño?
kable(TotalNum%>%filter(FullBath==0)%>%select(Id,HalfBath,BsmtFullBath,BsmtHalfBath))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	HalfBath	BsmtFullBath	BsmtHalfBath
54	1	2	0
189	2	2	0
376	1	1	0
598	2	0	2
635	0	2	0
917	0	1	0
1164	2	2	0
1214	0	1	1
1271	1	2	0
1860	2	2	0
2514	1	2	0
2601	1	2	0

Respuesta: Que tienen medios baños o baños en el sotano

Esta es la grafica de la relación entre los baños y el precio

pru<-ggplot()
pru<-pru+geom_boxplot(data=TotalNum,aes(x=TotalNum$FullBath,y=TotalNum$SalePrice,group=TotalNum$FullBath),color='red')
pru<-pru+labs(x='Baños ',y='Precio')+scale_y_continuous(labels = scales::comma)
pru
## Warning: Removed 1459 rows containing non-finite values (stat_boxplot).

Las vivendas sin baño están penalizadas en el precio aunque no demasiado

Si sumamos los baños como una estancia mas

#Sumamos los baños
TotalNum$estancias<-TotalNum$FullBath+TotalNum$TotRmsAbvGrd
kable(cor(TotalNum%>% select(GrLivArea,FullBath,TotRmsAbvGrd,estancias),method='spearman'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	GrLivArea	FullBath	TotRmsAbvGrd	estancias
GrLivArea	1.000000	0.662752	0.808775	0.852309
FullBath	0.662752	1.000000	0.536076	0.743707
TotRmsAbvGrd	0.808775	0.536076	1.000000	0.960388
estancias	0.852309	0.743707	0.960388	1.000000

Evidentemente la correlacion con las variables que la componen tiene que ser alta, pero con el area habitable mejora bastante la correlacion individual mejor que tenia antes

Voy a sumarle también los medios baños pero reducido a la mitad en su valor

#Sumamos los medios baños
TotalNum$estancias2<-TotalNum$FullBath+TotalNum$TotRmsAbvGrd+(TotalNum$HalfBath/2)
kable(cor(TotalNum%>% select(GrLivArea,FullBath,TotRmsAbvGrd,estancias,estancias2),method='spearman'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	GrLivArea	FullBath	TotRmsAbvGrd	estancias	estancias2
GrLivArea	1.000000	0.662752	0.808775	0.852309	0.865065
FullBath	0.662752	1.000000	0.536076	0.743707	0.723524
TotRmsAbvGrd	0.808775	0.536076	1.000000	0.960388	0.958442
estancias	0.852309	0.743707	0.960388	1.000000	0.991040
estancias2	0.865065	0.723524	0.958442	0.991040	1.000000

Aunque empeora la correlacion con las otras variables, mejora con el area habitable que es con la que voy a combinarla y normalizarlas

#Combinar con area habitable y normalizar
TotalNum$Habitat<-normalize(TotalNum$estancias2*TotalNum$GrLivArea)
#Comparamos con precio
TrainNum<-TotalNum%>%filter(is.na(SalePrice)==FALSE)
kable(cor(TrainNum%>% select(GrLivArea,FullBath,TotRmsAbvGrd,estancias,Habitat,SalePrice),method='spearman'))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	GrLivArea	FullBath	TotRmsAbvGrd	estancias	Habitat	SalePrice
GrLivArea	1.000000	0.658419	0.827874	0.860974	0.974100	0.731310
FullBath	0.658419	1.000000	0.558665	0.751499	0.714628	0.635957
TotRmsAbvGrd	0.827874	0.558665	1.000000	0.964700	0.916140	0.532586
estancias	0.860974	0.751499	0.964700	1.000000	0.948747	0.618233
Habitat	0.974100	0.714628	0.916140	0.948747	1.000000	0.704260
SalePrice	0.731310	0.635957	0.532586	0.618233	0.704260	1.000000

La nueva variable esta mucho mas correlacionada con las tres variables originales y además se acerca bastante a la variable original de mayor correlacion con el precio

Creamos en dataset conjunto y normalizamos

#Crear variable y normalizar
total$Habitat<-normalize((total$FullBath+total$TotRmsAbvGrd+(total$HalfBath/2))*total$GrLivArea)

1.5.3.5.6 Normalizacion de resto de variables

 GarageFinish    acabado interior del garaje

 KitchenQual   calidad de la cocina

 BsmtQual    Altura del sótano

 ExterQual   calidad del material exterior

 OverallQual   material general y calidad de acabado

Son todas variables ordinales que indican distintos acabados/calidades de la vivienda

Es razonable pensar que junto con otras variables que no aparecen por no estar tan relacionadas, mantengan una correspondencia al nivel general de calidad de la vivienda y este está asociado al precio de manera importante.

En mi opinión no tiene justificación lógica el combinar varias de estas variables puesto que no tienen una relación causal a pesar de que tengan una correlacion importante

Las normalizamos

total$GarageFinish<-normalize(total$GarageFinish)
total$KitchenQual<-normalize(total$KitchenQual)
total$BsmtQual<-normalize(total$BsmtQual)
total$ExterQual<-normalize(total$ExterQual)
total$OverallQual<-normalize(total$OverallQual)

1.5.3.5.7 CONCLUSION

De todas las variables cuantitativas nos quedamos con las siguientes:

 Antiguedad    AntGaraje   GarageTotal   FirePlaceQu   AreaPiso    Habitat   GarageFinish    KitchenQual      BsmtQual    ExterQual   OverallQual

De un total de 51 variables numéricas del dataset (excluyendo la identificación Id y el precio de venta) hemos reducido las variables predictoras a 11

1.5.4 FACTORES

En el caso del estudio de las variables categóricas, tenemos que partir de un enfoque diferente

Como estamos hablando de variables categóricas no podemos en principio calcular un valor directo como usábamos el de la correlacion en las variables continuas.

Pero si podemos usar el coeficiente de determinación o bondad del ajuste que en los casos de regresion lineal simple es el cuadrado de la correlacion de Pearson.

La manera simple mas directa es calculando variable por variable

#Columnas con valores categoricos
NFact<-which(sapply(total,is.factor))
TotalFact<-total[,NFact]
#Añado variables numericas Id y SalePrice
TotalFact$Id<-total$Id
TotalFact$SalePrice<-total$SalePrice
TrainFact<-TotalFact%>%filter(is.na(SalePrice)==FALSE)

#Calculo directo 
summary(lm(TrainFact$SalePrice ~ TrainFact$Foundation, data = TrainFact))
## 
## Call:
## lm(formula = TrainFact$SalePrice ~ TrainFact$Foundation, data = TrainFact)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -147230  -40230  -11118   24724  529770 
## 
## Coefficients:
##                            Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                  132291       5679   23.29   <2e-16 ***
## TrainFact$FoundationCBlock    17515       6300    2.78   0.0055 ** 
## TrainFact$FoundationPConc     92939       6288   14.78   <2e-16 ***
## TrainFact$FoundationSlab     -24926      15115   -1.65   0.0994 .  
## TrainFact$FoundationStone     33668      28586    1.18   0.2391    
## TrainFact$FoundationWood      53376      40025    1.33   0.1826    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 68600 on 1454 degrees of freedom
## Multiple R-squared:  0.256,  Adjusted R-squared:  0.254 
## F-statistic:  100 on 5 and 1454 DF,  p-value: <2e-16

Nos da un R² 0.2564. Esto equivaldria a una correlacion (si la variable fuera numerica) de 0.50635

Vemos con una de las variables numéricas que calculamos en la sección anterior

#Si comparo con variables numericas
Train<-total%>%filter(is.na(SalePrice)==FALSE)
summary(lm(Train$SalePrice ~ Train$Habitat, data = Train))
## 
## Call:
## lm(formula = Train$SalePrice ~ Train$Habitat, data = Train)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -467275  -28723   -4117   21521  310323 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      99401       2795    35.6   <2e-16 ***
## Train$Habitat   575911      16500    34.9   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 58700 on 1458 degrees of freedom
## Multiple R-squared:  0.455,  Adjusted R-squared:  0.455 
## F-statistic: 1.22e+03 on 1 and 1458 DF,  p-value: <2e-16

Para esta variable R²=0.4552. Luego la correlacion es 0.674685 Lo comprobamos

cor(x=Train$SalePrice,y=Train$Habitat)
## [1] 0.674692

Es igual. Si la elevamos al cuadrado tenemos 0.45520889

Luego la forma de seleccionar aquellas variables que tienen influencia sobre el precio va a ser calcular el coeficiente de determinación

Ahora bien, tenemos 28 variables categóricas.

Para facilitar esto vamos a usar el paquete FactoMineR.

Tiene varias opciones interesantes para realizar distintas métodos de analisis de datos y entre ellos tiene un método llamado condes() que sirve para describir una variable continua en función de variables continuas y/o categóricas

#Buscamos categorias mas proximas a SalePrice
fact1<-FactoMineR::condes(TrainFact,num.var = 30)

Esto nos genera una lista de tres elementos (como maximo)

Una matriz con las variables cualitativas ordenadas por R²
Una matriz con las variables cuantitativas ordenadas por correlacion
Una matriz con los coeficientes de cada categoría de las variables cualitativas que cumplen con el p-value asignado

Nuestro interés esta en la primera matriz.

Teniendo en cuenta que para la selección de las variables cuantitativas significativas poníamos como criterio que la correlacion debía ser superior a 0.5, entonces en este caso R² > (0.5)²=0.25 .

Ese es el limite que ponemos

#Estas son las variables
fact1.cuali<-as.data.frame(fact1[[1]])
kable(fact1.cuali)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	R2	p.value
Neighborhood	0.545575	0.000000
Foundation	0.256368	0.000000
GarageType	0.249204	0.000000
MSSubClass	0.246316	0.000000
MasVnrType	0.180235	0.000000
SaleCondition	0.135497	0.000000
Exterior1st	0.152773	0.000000
Exterior2nd	0.153830	0.000000
SaleType	0.137287	0.000000
MSZoning	0.107560	0.000000
HouseStyle	0.086313	0.000000
CentralAir	0.063166	0.000000
Electrical	0.059651	0.000000
PavedDrive	0.054540	0.000000
RoofStyle	0.057697	0.000000
Fence	0.035615	0.000000
BldgType	0.034534	0.000000
LandContour	0.025794	0.000000
RoofMatl	0.031413	0.000000
Condition1	0.032631	0.000000
Alley	0.020408	0.000000
LotConfig	0.021019	0.000003
Functional	0.016480	0.000484
Heating	0.014437	0.000753
MiscFeature	0.007080	0.035004
Condition2	0.009899	0.043426

Aqui estan las primeras categorias

fact1.var<-as.data.frame(fact1[[2]])
kable(head(fact1.var))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

	Estimate	p.value
PConc	64177.3	0
NridgHt	132305.8	0
2-STORY 1946 & NEWER	85904.5	0
New	88807.5	0
Partial	103104.6	0
Attchd	43339.9	0

Si vemos las variables solo hay dos que superan un R² de 0.25, pero teniendo en cuenta que como en las variables numéricas no había normalidad y para la correlacion use el método de Spearman que suele dar un valor ligeramente superior al de Pearson, en este caso voy a escoger también las dos variables que se han quedado a las puertas con 0.24

En resumen :

 `Neighborhood`  ubicaciones físicas dentro de los límites de la ciudad de Ames
                    Tiene 25 categorias

 `MSSubClass`    la clase de construcción.   Tiene 16 categorias

 `Foundation`    tipo de cimientos.      Tiene 6 categorias

 `GarageType`    ubicación del garaje        Tiene 7 categorias

Son un total de 54 categorias.

Si usamos one hot encoding suponen (25-1)+(16-1)+(6-1)+(7-1)=50 nuevas variables a añadir a las 11 numericas que ya tenemos.

Hay que reducirlas

Las revisamos:

1.5.4.1 NEIGHBORHOOD (Vecindario)

Esta variable tiene 25 categorias. Veamos grafica y ordenadamente por la media y la mediana

pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Neighborhood,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue')
pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
pru<-pru+labs(x='Barrio',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3))
pru


pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Neighborhood,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen')
pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median)
pru<-pru+labs(x='Barrio',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3))
pru

Voy a intentar reducir las variables.

Para eso voy a utilizar una clasificación jerarquica aglomerativa sencilla mediante hclust.

Voy a realizar varias clasificaciones y recalcular el coeficiente de determinación que quedaria antes de decidir .Los clusters van de 3 a 8 agrupaciones

Los resultados los presento juntas las cuatro variables

Aqui solo aparecen los dendogramas

#Preparacion
Resultados.vecinos<-matrix(ncol=3)
#MATRICES DE RESULTADOS
#Prueba clusterizacion medias
#Obtencion de los datos 
train.prueba<-TrainFact%>%group_by(Neighborhood)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Neighborhood
#clusterizacion y guarda de informacion
train.hcl<-hclust(dist(train.prueba2))
ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Barrio',cutree(train.hcl,k=3))
train.dat[,3]<-paste0('Barrio',cutree(train.hcl,k=4))
train.dat[,4]<-paste0('Barrio',cutree(train.hcl,k=5))
train.dat[,5]<-paste0('Barrio',cutree(train.hcl,k=6))
train.dat[,6]<-paste0('Barrio',cutree(train.hcl,k=7))
train.dat[,7]<-paste0('Barrio',cutree(train.hcl,k=8))

#Se crean nuevas columnas con los clusters calculados
TrainFact$NeighborhoodMean1<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean1)<- train.dat[,2]
TrainFact$NeighborhoodMean2<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean2)<- train.dat[,3]
TrainFact$NeighborhoodMean3<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean3)<- train.dat[,4]
TrainFact$NeighborhoodMean4<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean4)<- train.dat[,5]
TrainFact$NeighborhoodMean5<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean5)<- train.dat[,6]
TrainFact$NeighborhoodMean6<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMean6)<- train.dat[,7]

#Prueba clusterizacion medianas
#Obtencion de los datos 
train.prueba3<-TrainFact%>%group_by(Neighborhood)
train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice))
rownames(train.prueba4)<-train.prueba4$Neighborhood
#clusterizacion y guarda de informacion
train.hcl2<-hclust(dist(train.prueba4))
ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat2<-rownames(train.prueba4)
train.dat2<-as.data.frame(train.dat2)
train.dat2[,2]<-paste0('Barrio', cutree(train.hcl2,k=3))
train.dat2[,3]<-paste0('Barrio', cutree(train.hcl2,k=4))
train.dat2[,4]<-paste0('Barrio',cutree(train.hcl2,k=5))
train.dat2[,5]<-paste0('Barrio',cutree(train.hcl2,k=6))
train.dat2[,6]<-paste0('Barrio',cutree(train.hcl2,k=7))
train.dat2[,7]<-paste0('Barrio', cutree(train.hcl2,k=8))

#Se crean nuevas columnas con los clusters calculados
TrainFact$NeighborhoodMedian1<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian1)<- train.dat2[,2]
TrainFact$NeighborhoodMedian2<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian2)<- train.dat2[,3]
TrainFact$NeighborhoodMedian3<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian3)<- train.dat2[,4]
TrainFact$NeighborhoodMedian4<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian4)<- train.dat2[,5]
TrainFact$NeighborhoodMedian5<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian5)<- train.dat2[,6]
TrainFact$NeighborhoodMedian6<-TrainFact$Neighborhood
levels(TrainFact$NeighborhoodMedian6)<- train.dat2[,7]

#Presentacion resultados
Resultados.vecinos<-cbind(c(3,4,5,6,7,8,'Todos'))
Resultados.vecinos<-cbind(Resultados.vecinos,c(condes(TrainFact%>%select(Id,NeighborhoodMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMean6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Neighborhood,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.vecinos<-cbind(Resultados.vecinos,c(condes(TrainFact%>%select(Id,NeighborhoodMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,NeighborhoodMedian6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Neighborhood,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.vecinos<-as.data.frame(Resultados.vecinos)
colnames(Resultados.vecinos)<-c('Numero clusters','R2 Media','R2 Mediana')

1.5.4.2 FOUNDATION (Cimientos)

Esta variable tiene 6 categorias. Veamos grafica y ordenadamente por la media y la mediana


pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Foundation,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue')
pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
pru<-pru+labs(x='Tipo de cimiento',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3))
pru


pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$Foundation,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen')
pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median)
pru<-pru+labs(x='Tipo de cimiento',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3))
pru

Realizamos la misma operación que con el vecindario, solo que aquí tenemos 6 grupos por lo que los cluster van de 2 a 5

Los resultados los presento juntas las cuatro variables

Aqui solo aparecen los dendogramas

#Preparacion
Resultados.cimientos<-matrix(ncol=3)
#MATRICES DE RESULTADOS
#Prueba clusterizacion medias
#Obtencion de los datos 
train.prueba<-TrainFact%>%group_by(Foundation)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Foundation
#clusterizacion y guarda de informacion
train.hcl<-hclust(dist(train.prueba2))
ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Cimiento',cutree(train.hcl,k=2))
train.dat[,3]<-paste0('Cimiento',cutree(train.hcl,k=3))
train.dat[,4]<-paste0('Cimiento',cutree(train.hcl,k=4))
train.dat[,5]<-paste0('Cimiento',cutree(train.hcl,k=5))
#Se crean nuevas columnas con los clusters calculados
TrainFact$FoundationMean1<-TrainFact$Foundation
levels(TrainFact$FoundationMean1)<- train.dat[,2]
TrainFact$FoundationMean2<-TrainFact$Foundation
levels(TrainFact$FoundationMean2)<- train.dat[,3]
TrainFact$FoundationMean3<-TrainFact$Foundation
levels(TrainFact$FoundationMean3)<- train.dat[,4]
TrainFact$FoundationMean4<-TrainFact$Foundation
levels(TrainFact$FoundationMean4)<- train.dat[,5]

#Prueba clusterizacion medianas
#Obtencion de los datos 
train.prueba3<-TrainFact%>%group_by(Foundation)
train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice))
rownames(train.prueba4)<-train.prueba4$Foundation
train.hcl2<-hclust(dist(train.prueba4))
ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat2<-rownames(train.prueba4)
train.dat2<-as.data.frame(train.dat2)
train.dat2[,2]<-paste0('Cimiento', cutree(train.hcl2,k=2))
train.dat2[,3]<-paste0('Cimiento',cutree(train.hcl2,k=3))
train.dat2[,4]<-paste0('Cimiento',cutree(train.hcl2,k=4))
train.dat2[,5]<-paste0('Cimiento',cutree(train.hcl2,k=5))
#Se crean nuevas columnas con los clusters calculados
TrainFact$FoundationMedian1<-TrainFact$Foundation
levels(TrainFact$FoundationMedian1)<- train.dat2[,2]
TrainFact$FoundationMedian2<-TrainFact$Foundation
levels(TrainFact$FoundationMedian2)<- train.dat2[,3]
TrainFact$FoundationMedian3<-TrainFact$Foundation
levels(TrainFact$FoundationMedian3)<- train.dat2[,4]
TrainFact$FoundationMedian4<-TrainFact$Foundation
levels(TrainFact$FoundationMedian4)<- train.dat2[,5]

#Presentacion resultados
Resultados.cimientos<-cbind(c(2,3,4,5,'Todos'))
Resultados.cimientos<-cbind(Resultados.cimientos,c(condes(TrainFact%>%select(Id,FoundationMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Foundation,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.cimientos<-cbind(Resultados.cimientos,c(condes(TrainFact%>%select(Id,FoundationMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,FoundationMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,Foundation,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.cimientos<-as.data.frame(Resultados.cimientos)
colnames(Resultados.cimientos)<-c('Numero clusters','R2 Media','R2 Mediana')

1.5.4.3 GARAGETYPE (Ubicacion del garage)

Esta variable tiene 7 categorias. Veamos grafica y ordenadamente por la media y la mediana

pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$GarageType,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue')
pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
pru<-pru+labs(x='Ubicacion Garaje',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3))
pru


pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$GarageType,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen')
pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median)
pru<-pru+labs(x='Ubicacion Garaje',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 45,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3))
pru

Realizamos la misma operación que con el vecindario, solo que aquí tenemos 7 grupos por lo que los cluster van de 2 a 5

Los resultados los presento juntas las cuatro variables

Aqui solo aparecen los dendogramas

#Preparacion
Resultados.garage<-matrix(ncol=3)
#MATRICES DE RESULTADOS
#Prueba clusterizacion medias
#Obtencion de los datos 
train.prueba<-TrainFact%>%group_by(GarageType)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$GarageType
#clusterizacion y guarda de informacion
train.hcl<-hclust(dist(train.prueba2))
ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('garage',cutree(train.hcl,k=2))
train.dat[,3]<-paste0('garage',cutree(train.hcl,k=3))
train.dat[,4]<-paste0('garage',cutree(train.hcl,k=4))
train.dat[,5]<-paste0('garage',cutree(train.hcl,k=5))
#Se crean nuevas columnas con los clusters calculados
TrainFact$GarageTypeMean1<-TrainFact$GarageType
levels(TrainFact$GarageTypeMean1)<- train.dat[,2]
TrainFact$GarageTypeMean2<-TrainFact$GarageType
levels(TrainFact$GarageTypeMean2)<- train.dat[,3]
TrainFact$GarageTypeMean3<-TrainFact$GarageType
levels(TrainFact$GarageTypeMean3)<- train.dat[,4]
TrainFact$GarageTypeMean4<-TrainFact$GarageType
levels(TrainFact$GarageTypeMean4)<- train.dat[,5]

#Prueba clusterizacion medianas
#Obtencion de los datos 
train.prueba3<-TrainFact%>%group_by(GarageType)
train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice))
rownames(train.prueba4)<-train.prueba4$GarageType
#clusterizacion y guarda de informacion
train.hcl2<-hclust(dist(train.prueba4))
ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat2<-rownames(train.prueba4)
train.dat2<-as.data.frame(train.dat2)
train.dat2[,2]<-paste0('garage', cutree(train.hcl2,k=2))
train.dat2[,3]<-paste0('garage',cutree(train.hcl2,k=3))
train.dat2[,4]<-paste0('garage',cutree(train.hcl2,k=4))
train.dat2[,5]<-paste0('garage',cutree(train.hcl2,k=5))
#Se crean nuevas columnas con los clusters calculados
TrainFact$GarageTypeMedian1<-TrainFact$GarageType
levels(TrainFact$GarageTypeMedian1)<- train.dat2[,2]
TrainFact$GarageTypeMedian2<-TrainFact$GarageType
levels(TrainFact$GarageTypeMedian2)<- train.dat2[,3]
TrainFact$GarageTypeMedian3<-TrainFact$GarageType
levels(TrainFact$GarageTypeMedian3)<- train.dat2[,4]
TrainFact$GarageTypeMedian4<-TrainFact$GarageType
levels(TrainFact$GarageTypeMedian4)<- train.dat2[,5]

#Presentacion resultados
Resultados.garage<-cbind(c(2,3,4,5,'Todos'))
Resultados.garage<-cbind(Resultados.garage,c(condes(TrainFact%>%select(Id,GarageTypeMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageType,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.garage<-cbind(Resultados.garage,c(condes(TrainFact%>%select(Id,GarageTypeMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageTypeMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,GarageType,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.garage<-as.data.frame(Resultados.garage)
colnames(Resultados.garage)<-c('Numero clusters','R2 Media','R2 Mediana')

1.5.4.4 MSSUBCLASS (CLase de construccion)

Esta variable tiene 16 categorias. Veamos grafica y ordenadamente por la media y la mediana

pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$MSSubClass,TrainFact$SalePrice,FUN = 'mean'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'mean',fill='royalblue')
pru<-pru+stat_summary(fun.data = give.n, geom = "text", fun.y = mean)
pru<-pru+labs(x='Clase Construccion',y='Precio',title='MEDIAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 60,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='red',hjust=.3))
pru


pru<-ggplot(data=TrainFact,aes(x=reorder(TrainFact$MSSubClass,TrainFact$SalePrice,FUN = 'median'), y=TrainFact$SalePrice))
pru<-pru+geom_bar(stat = 'summary',fun.y = 'median',fill='springgreen')
pru<-pru+stat_summary(fun.data = give1.n, geom = "text", fun.y = median)
pru<-pru+labs(x='Clase Construccion',y='Precio',title='MEDIANAS')+scale_y_continuous(labels = scales::comma)
pru<-pru+theme(axis.text.x = element_text(angle = 60,hjust=1,vjust=1),title = element_text(color="mediumblue",size=12,lineheight = 1),plot.title = element_text(color='darkorange',hjust=.3))
pru

Esta variable es mas peculiar. Vemos sus categorías y apariciones

kable(table(TrainFact$MSSubClass))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
1-STORY 1946 & NEWER ALL STYLES	536
1-STORY 1945 & OLDER	69
1-STORY W/FINISHED ATTIC ALL AGES	4
1-1/2 STORY - UNFINISHED ALL AGES	12
1-1/2 STORY FINISHED ALL AGES	144
2-STORY 1946 & NEWER	299
2-STORY 1945 & OLDER	60
2-1/2 STORY ALL AGES	16
SPLIT OR MULTI-LEVEL	58
SPLIT FOYER	20
DUPLEX - ALL STYLES AND AGES	52
1-STORY PUD (Planned Unit Development) - 1946 & NEWER	87
1-1/2 STORY PUD - ALL AGES	0
2-STORY PUD - 1946 & NEWER	63
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER	10
2 FAMILY CONVERSION - ALL STYLES AND AGES	30

Tenemos una categoria con 0 casos en el Train

Buscamos en el dataset Test

TestFact<-TotalFact%>%filter(is.na(SalePrice)==TRUE)
kable(table(TestFact$MSSubClass))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
1-STORY 1946 & NEWER ALL STYLES	543
1-STORY 1945 & OLDER	70
1-STORY W/FINISHED ATTIC ALL AGES	2
1-1/2 STORY - UNFINISHED ALL AGES	6
1-1/2 STORY FINISHED ALL AGES	143
2-STORY 1946 & NEWER	276
2-STORY 1945 & OLDER	68
2-1/2 STORY ALL AGES	7
SPLIT OR MULTI-LEVEL	60
SPLIT FOYER	28
DUPLEX - ALL STYLES AND AGES	57
1-STORY PUD (Planned Unit Development) - 1946 & NEWER	95
1-1/2 STORY PUD - ALL AGES	1
2-STORY PUD - 1946 & NEWER	65
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER	7
2 FAMILY CONVERSION - ALL STYLES AND AGES	31

Tiene 1 caso, luego no se puede eliminar directamente de todo el conjunto, pero si debemos NO tomarlo en consideracion para la reduccion de variables porque si no trastornaria todos los calculos

TestFact%>%filter(MSSubClass=='1-1/2 STORY PUD - ALL AGES')%>%select(Id)

#Descarto este level para el calculo
TrainFact$MSSubClass<-droplevels(TrainFact$MSSubClass,exclude='1-1/2 STORY PUD - ALL AGES')
kable(table(TrainFact$MSSubClass))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
1-STORY 1946 & NEWER ALL STYLES	536
1-STORY 1945 & OLDER	69
1-STORY W/FINISHED ATTIC ALL AGES	4
1-1/2 STORY - UNFINISHED ALL AGES	12
1-1/2 STORY FINISHED ALL AGES	144
2-STORY 1946 & NEWER	299
2-STORY 1945 & OLDER	60
2-1/2 STORY ALL AGES	16
SPLIT OR MULTI-LEVEL	58
SPLIT FOYER	20
DUPLEX - ALL STYLES AND AGES	52
1-STORY PUD (Planned Unit Development) - 1946 & NEWER	87
2-STORY PUD - 1946 & NEWER	63
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER	10
2 FAMILY CONVERSION - ALL STYLES AND AGES	30

Podemos ver que ya no figura

Realizamos la misma operación que con el vecindario, solo que aquí tenemos 16 (15 con la que no tratamos transitoriamente) grupos por lo que los cluster van de 3 a 8

Los resultados los presento juntas las cuatro variables

Aqui solo aparecen los dendogramas

#Preparacion
Resultados.clases<-matrix(ncol=3)
#MATRICES DE RESULTADOS
#Prueba clusterizacion medias
#Obtencion de los datos 
train.prueba<-TrainFact%>%group_by(MSSubClass)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$MSSubClass
#clusterizacion y guarda de informacion
train.hcl<-hclust(dist(train.prueba2))
ggdendrogram(train.hcl,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Clase',cutree(train.hcl,k=3))
train.dat[,3]<-paste0('Clase',cutree(train.hcl,k=4))
train.dat[,4]<-paste0('Clase',cutree(train.hcl,k=5))
train.dat[,5]<-paste0('Clase',cutree(train.hcl,k=6))
train.dat[,6]<-paste0('Clase',cutree(train.hcl,k=7))
train.dat[,7]<-paste0('Clase',cutree(train.hcl,k=8))

#Se crean nuevas columnas con los clusters calculados
TrainFact$MSSubClassMean1<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean1)<- train.dat[,2]
TrainFact$MSSubClassMean2<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean2)<- train.dat[,3]
TrainFact$MSSubClassMean3<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean3)<- train.dat[,4]
TrainFact$MSSubClassMean4<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean4)<- train.dat[,5]
TrainFact$MSSubClassMean5<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean5)<- train.dat[,6]
TrainFact$MSSubClassMean6<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMean6)<- train.dat[,7]

#Prueba clusterizacion medianas
#Obtencion de los datos 
train.prueba3<-TrainFact%>%group_by(MSSubClass)
train.prueba4<-train.prueba3%>%summarise(media=median(SalePrice))
rownames(train.prueba4)<-train.prueba4$MSSubClass
#clusterizacion y guarda de informacion
train.hcl2<-hclust(dist(train.prueba4))
ggdendrogram(train.hcl2,rotate=TRUE,size=20,theme_dendro = FALSE, color='black')

train.dat2<-rownames(train.prueba4)
train.dat2<-as.data.frame(train.dat2)
train.dat2[,2]<-paste0('Clase', cutree(train.hcl2,k=3))
train.dat2[,3]<-paste0('Clase',cutree(train.hcl2,k=4))
train.dat2[,4]<-paste0('Clase',cutree(train.hcl2,k=5))
train.dat2[,5]<-paste0('Clase',cutree(train.hcl2,k=6))
train.dat2[,6]<-paste0('Clase',cutree(train.hcl2,k=7))
train.dat2[,7]<-paste0('Clase',cutree(train.hcl2,k=8))

#Se crean nuevas columnas con los clusters calculados
TrainFact$MSSubClassMedian1<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian1)<- train.dat2[,2]
TrainFact$MSSubClassMedian2<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian2)<- train.dat2[,3]
TrainFact$MSSubClassMedian3<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian3)<- train.dat2[,4]
TrainFact$MSSubClassMedian4<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian4)<- train.dat2[,5]
TrainFact$MSSubClassMedian5<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian5)<- train.dat2[,6]
TrainFact$MSSubClassMedian6<-TrainFact$MSSubClass
levels(TrainFact$MSSubClassMedian6)<- train.dat2[,7]

#Presentacion resultados
Resultados.clases<-cbind(c(3,4,5,6,7,8,'Todos'))
Resultados.clases<-cbind(Resultados.clases,c(condes(TrainFact%>%select(Id,MSSubClassMean1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMean6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClass,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.clases<-cbind(Resultados.clases,c(condes(TrainFact%>%select(Id,MSSubClassMedian1,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian2,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian3,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian4,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian5,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClassMedian6,SalePrice),num.var=3,proba = 0.05)[[1]][[1]],condes(TrainFact%>%select(Id,MSSubClass,SalePrice),num.var=3,proba = 0.05)[[1]][[1]]))
Resultados.clases<-as.data.frame(Resultados.clases)
colnames(Resultados.clases)<-c('Numero clusters','R2 Media','R2 Mediana')

1.5.4.5 CONCLUSIONES

He obtenido en las siguientes tablas los coeficientes de determinación las variables agrupadas en diferentes clusters.

Tambien figura el valor del que partíamos

#Añado la diferencia en columna
options(digits=8)

Resultados.cimientos$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.cimientos$`R2 Media`))[Resultados.cimientos$`R2 Media`]-as.numeric(levels(Resultados.cimientos$`R2 Mediana`))[Resultados.cimientos$`R2 Mediana`])
Resultados.clases$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.clases$`R2 Media`))[Resultados.clases$`R2 Media`]-as.numeric(levels(Resultados.clases$`R2 Mediana`))[Resultados.clases$`R2 Mediana`])
Resultados.garage$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.garage$`R2 Media`))[Resultados.garage$`R2 Media`]-as.numeric(levels(Resultados.garage$`R2 Mediana`))[Resultados.garage$`R2 Mediana`])
Resultados.vecinos$Diferencia_Media_Mediana<-as.factor(as.numeric(levels(Resultados.vecinos$`R2 Media`))[Resultados.vecinos$`R2 Media`]-as.numeric(levels(Resultados.vecinos$`R2 Mediana`))[Resultados.vecinos$`R2 Mediana`])

La idea es optimizar el numero que nos quedaremos teniendo en cuenta que ya tenemos 11 variables numéricas

Lo primero mas destacable que se observa es que no hay diferencias tomando la media o la mediana de los precios en la variable GarageType.

Esto se explica porque el dendograma es idéntico en ambos supuestos. Aqui se puede ver

Lo segundo que destaca es que en la gran mayoría de los supuestos tomar como referencia la media del precio suele ser mejor que hacerlo con la mediana. La diferencia es positiva en la mayoría de los casos.

Como criterios:

En primer lugar seguir el orden asignado por el coeficiente de determinación general. Tendran preferencias las categorías de Neighborhood, sobre el resto, luego Foundation, GarageType y por ultimo MSSubClass
Luego elegir aquel agrupamiento en que el paso a un numero de cluster menor suponga una diferencia muy superior a la que supuso el paso anterior (de un numero de clusters mayor) Vemos todo en una tabla con una vista mas amigable

kable(Resultados.vecinos)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(2,background = 'yellow')%>%row_spec(3,background = 'lawngreen')

Numero clusters	R2 Media	R2 Mediana	Diferencia_Media_Mediana
3	0.510288922673946	0.510288922673946	0
4	0.520752826029343	0.519728064432752	0.00102476159659104
5	0.534661463050312	0.533467614063988	0.00119384898632402
6	0.536798653780542	0.533811092372337	0.002987561408205
7	0.541121980460839	0.539159180649222	0.00196279981161707
8	0.542448822452204	0.54101354304445	0.00143527940775401
Todos	0.545574990809563	0.545574990809563	0


kable(Resultados.cimientos)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(1,background = 'orange1')%>%row_spec(3,background = 'yellow')%>%row_spec(4,background = 'lawngreen')

Numero clusters	R2 Media	R2 Mediana	Diferencia_Media_Mediana
2	0.0568254698693131	0.247754678851469	-0.190929208982156
3	0.254395725745173	0.248262307945321	0.00613341779985199
4	0.2548092461983	0.252170668995711	0.00263857720258898
5	0.256199967397587	0.255658927697032	0.000541039700554968
Todos	0.256368401530415	0.256368401530415	0


kable(Resultados.garage)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(2,background = 'orange1')%>%row_spec(3,background = 'lawngreen')

Numero clusters	R2 Media	R2 Mediana
2	0.216280939876281	0.216280939876281
3	0.224281569646271	0.224281569646271
4	0.247622864331931	0.247622864331931
5	0.249122673737389	0.249122673737389
Todos	0.249204230504291	0.249204230504291


kable(Resultados.clases)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(1,background = 'orange1')%>%row_spec(3,background = 'yellow')%>%row_spec(4,background = 'lawngreen')

Numero clusters	R2 Media	R2 Mediana	Diferencia_Media_Mediana
3	0.174786074913226	0.188741697652476	-0.01395562273925
4	0.235584333942853	0.230629760361157	0.00495457358169599
5	0.239410301887266	0.241858637138703	-0.00244833525143701
6	0.243776881430928	0.241878911205326	0.00189797022560198
7	0.245698829986421	0.241915556005449	0.003783273980972
8	0.24576269922555	0.242459440131863	0.00330325909368701
Todos	0.246315972817565	0.246315972817565	0

Hemos descartado trabajar con la mediana.

Descartamos primero aquellas con un coeficiente muy bajo. Las tacho en naranja. Ese es el minimo

Marco la fila de las casillas de salto mas grandes en amarillo. Elegir el valor de cluster anterior es una buena forma de comenzar

Tenemos que la primera elección es :

Vecinos: 5 clusters sobre 25 categorias Correlacion ~0.7312
Cimientos 5 clusters sobre 6 categorias Correlacion ~0.5061
Garaje 4 clusters sobre 7 categorias Correlacion~0.4976
Clases 6 clusters sobre 16 categorias Correlacion ~0.4937

Son un total de 20 categorias.

En las dos ultimas (Garage y Clases ) parece difícil reducir mas sin que haya una perdida importante, y ya están muy al limite.

Quizas podríamos reducir uno o dos mas en Cimientos, pero la cantidad de 31 variables numéricas , entre las originales y las reconvertidas puede ser una buena cifra

Para realizar la actualización recuperamos parte del código con el numero cluster que hemos decidido

#Escojo los agrupamientos
#Vecinos 5 clusters
train.prueba<-TrainFact%>%group_by(Neighborhood)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Neighborhood
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Barrio',cutree(train.hcl,k=5))
TotalFact$NeighborhoodMean4<-TotalFact$Neighborhood
levels(TotalFact$NeighborhoodMean4)<- train.dat[,2]
total$Vecindario<-TotalFact$NeighborhoodMean4

#Cimientos 5 clusters
train.prueba<-TrainFact%>%group_by(Foundation)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Foundation
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Cimientos',cutree(train.hcl,k=5))
TotalFact$FoundationMean4<-TotalFact$Foundation
levels(TotalFact$FoundationMean4)<- train.dat[,2]
total$Cimientos<-TotalFact$FoundationMean4

#Garage 4 clusters
train.prueba<-TrainFact%>%group_by(GarageType)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$GarageType
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Garage',cutree(train.hcl,k=4))
TotalFact$GarageTypeMean3<-TotalFact$GarageType
levels(TotalFact$GarageTypeMean3)<- train.dat[,2]
total$UbicaGarage<-TotalFact$GarageTypeMean3

Para el caso de la variable MSSubClass tenemos que recordar que para hacer la agrupación teníamos una categoría que se encontraba en el dataset Test pero no en el Train, luego dejamos esa categoría apartada , pero ahora hay que introducirla manualmente en un cluster.

Para encontrar en que cluster voy a buscar registros con ciertas variables muy correlacionadas con el objetivo y que se parezcan a las del que buscamos.

Voy a usar las variables numéricas Habitat, AreaPiso y OverallQual

Primero identificamos el registro

#Clases 6 clusters
#TrainFact$MSSubClassMean4
#Busqueda
kable(total%>%filter(MSSubClass=='1-1/2 STORY PUD - ALL AGES')%>%select(Id,AreaPiso,Habitat,OverallQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	AreaPiso	Habitat	OverallQual
2819	0.09323653	0.17182298	0.66666667

A continuacion escogemos las ventanas de los parametros para el filtrado

0.06<AreaPiso<0.12

0.16<Habitat<0.18

0.6<OverallQual<0.7

Filtramos por aproximacion a estas variables

prue<-total%>%filter(OverallQual>0.6 & OverallQual<0.7)%>%select(Id,AreaPiso,Habitat,MSSubClass)
prue<-prue%>%filter(AreaPiso>0.06 & AreaPiso<0.12)
prue<-prue%>%filter(Habitat>0.16 & Habitat<0.18)%>%select(Id,MSSubClass)
kable(table(prue$MSSubClass))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Var1	Freq
1-STORY 1946 & NEWER ALL STYLES	0
1-STORY 1945 & OLDER	0
1-STORY W/FINISHED ATTIC ALL AGES	0
1-1/2 STORY - UNFINISHED ALL AGES	0
1-1/2 STORY FINISHED ALL AGES	0
2-STORY 1946 & NEWER	9
2-STORY 1945 & OLDER	0
2-1/2 STORY ALL AGES	0
SPLIT OR MULTI-LEVEL	1
SPLIT FOYER	0
DUPLEX - ALL STYLES AND AGES	0
1-STORY PUD (Planned Unit Development) - 1946 & NEWER	0
1-1/2 STORY PUD - ALL AGES	1
2-STORY PUD - 1946 & NEWER	0
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER	0
2 FAMILY CONVERSION - ALL STYLES AND AGES	0

Hay 11 registros con campos parecidos, incluido el que buscamos.

La gran mayoría 9 tienen en MSSubClass 2-STORY 1946 & NEWER.

Donde esté esta categoría agrupada pondremos la que nos falta

#Modificacion
train.prueba<-TrainFact%>%group_by(MSSubClass)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$MSSubClass
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Clase',cutree(train.hcl,k=6))
TotalFact$MSSubClassMean4<-TotalFact$MSSubClass

Hasta aquí es todo igual.

Vamos a buscar en que grupo queda 2-STORY 1946 & NEWER que es donde hay que meter el nivel de factor que nos falta

#Vemos el que falta y se añade
kable(train.dat)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

train.dat	V2
1-STORY 1946 & NEWER ALL STYLES	Clase1
1-STORY 1945 & OLDER	Clase2
1-STORY W/FINISHED ATTIC ALL AGES	Clase3
1-1/2 STORY - UNFINISHED ALL AGES	Clase2
1-1/2 STORY FINISHED ALL AGES	Clase3
2-STORY 1946 & NEWER	Clase4
2-STORY 1945 & OLDER	Clase5
2-1/2 STORY ALL AGES	Clase1
SPLIT OR MULTI-LEVEL	Clase5
SPLIT FOYER	Clase3
DUPLEX - ALL STYLES AND AGES	Clase6
1-STORY PUD (Planned Unit Development) - 1946 & NEWER	Clase1
2-STORY PUD - 1946 & NEWER	Clase6
PUD - MULTILEVEL - INCL SPLIT LEV/FOYER	Clase2
2 FAMILY CONVERSION - ALL STYLES AND AGES	Clase6

Es el elemento numero 9 que corresponde a Clase4

Ademas

levels(total$MSSubClass)
##  [1] "1-STORY 1946 & NEWER ALL STYLES"                      
##  [2] "1-STORY 1945 & OLDER"                                 
##  [3] "1-STORY W/FINISHED ATTIC ALL AGES"                    
##  [4] "1-1/2 STORY - UNFINISHED ALL AGES"                    
##  [5] "1-1/2 STORY FINISHED ALL AGES"                        
##  [6] "2-STORY 1946 & NEWER"                                 
##  [7] "2-STORY 1945 & OLDER"                                 
##  [8] "2-1/2 STORY ALL AGES"                                 
##  [9] "SPLIT OR MULTI-LEVEL"                                 
## [10] "SPLIT FOYER"                                          
## [11] "DUPLEX - ALL STYLES AND AGES"                         
## [12] "1-STORY PUD (Planned Unit Development) - 1946 & NEWER"
## [13] "1-1/2 STORY PUD - ALL AGES"                           
## [14] "2-STORY PUD - 1946 & NEWER"                           
## [15] "PUD - MULTILEVEL - INCL SPLIT LEV/FOYER"              
## [16] "2 FAMILY CONVERSION - ALL STYLES AND AGES"

Tiene que ir en la posicion numero 13.

La añadiremos como una fila a train.dat desplazando el resto

#Añado el level
levels(train.dat$train.dat)<-c(levels(train.dat$train.dat),'1-1/2 STORY PUD - ALL AGES')
#Añado la fila
train.dat<-rbind(train.dat,c('1-1/2 STORY PUD - ALL AGES','Clase4'))
#Cojo levels originales como vector
lev<-as.vector(levels(total$MSSubClass))
#Comparo y ordeno
train.dat<-train.dat[match(lev,train.dat$train.dat),]

#Ya estan ordenados los level y los valores que les sutituyen
levels(TotalFact$MSSubClassMean4)<-train.dat$V2
total$Clases<-TotalFact$MSSubClassMean4

2 MODELIZACION

Para buscar el modelo que mas conviene tomar para realizar la prediccion que se pide voy a dividir el conjunto de predictores en varias partes.

Por un lado aquellos predictores que son desde el origen numéricos y que además son continuos o discretos con un numero amplio de intervalos

Son :Antiguedad, AntGarage, AreaPiso, GarageTotal, Habitat y OverallQual

En otro grupo los predictores numéricos de origen ordinal con un numero pequeño de intevalos.

Son : BsmtQual, ExterQual, FireplaceQu, GarageFinish y KitchenQual

En el ultimo grupo los predictores de origen categoricos

Son : Neighborhood, Foundation, GarageType y MSSubClass

Esta división solo la hago en sentido grafico para apreciar mejor las diversas características

Voy a aplicar un modelo lineal multiple, uno polinómico, otro suavizado tipo Loess y uno suavizado con curvas Spline y vamos a comparar en cada variable con respecto a la objetivo SalePrice

Aunque el grafico es muy completo entre toda las variables solos nos interesa la fila inferior donde aparecen los graficos de cada predictor en función del objetivo

Podemos ver también en las primeras graficas en la columna mas a la derecha el valor de correlacion de SalePrice con el resto de variables

2.1 NUMERICAS Continuas y discreta con muchas agrupaciones

Primero una vision de conjunto

#preparacion datos
Model1<-total%>%select(Id,Antiguedad,AntGarage,AreaPiso,GarageTotal,Habitat,OverallQual,SalePrice)
ModelTrain1<-Model1%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)


GGP1<-ggpairs(ModelTrain1, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo")
GGP1<-GGP1+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP1


GGP2<-ggpairs(ModelTrain1, lower = list(continuous = my_rg2), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: B Splines (bs)-Purpura y Modelo lineal polinomico (poly)-Naranja")
GGP2<-GGP2+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP2


GGP3<-ggpairs(ModelTrain1, lower = list(continuous = my_rg3), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: B Splines (bs)-Verde y Suavizado Local(Loess)-Rojo")
GGP3<-GGP3+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP3

Vemos ahora en detalle


#Plots individuales
p11<-getPlot(GGP1,7,1)
p12<-getPlot(GGP1,7,2)
p13<-getPlot(GGP1,7,3)
p14<-getPlot(GGP1,7,4)
p15<-getPlot(GGP1,7,5)
p16<-getPlot(GGP1,7,6)
p31<-getPlot(GGP3,7,1)
p36<-getPlot(GGP3,7,6)


p11<-p11+labs(title="Antiguedad")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p12<-p12+labs(title="AntGarage")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p13<-p13+labs(title="AreaPiso")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p14<-p14+labs(title="GarageTotal")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p15<-p15+labs(title="Habitat")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p16<-p16+labs(title="OverallQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p31<-p31+labs(title="Antiguedad")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p36<-p36+labs(title="OverallQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))

p11

Antigüedad: Se adapta mejor la curva suavizada que la recta

p12

AntGarage: la especificidad de los datos (como poner antigüedad a los que no tienen garaje) hace que salga una grafica extraña, pero me decanto por el modelo lineal

p13

AreaPiso: los outliers hacen que las curvas no sirvan

p14

GarageTotal: Es el mismo caso que el anterior

p15

Habitat: Es el mismo caso que el anterior

p16

OverallQual: Pasa algo parecido que con la antigüedad. Se adapta mejor una curva

Vemos las dos variables que se adaptan mejor a las curvas en comparativa de Loess y B Spline

p31

p36

Hay pequeñas diferencias pero no son apreciables para decantarse por un modelo . Lo veremos numericamente

2.2 NUMERICAS discretas (resto)

Primero una vision de conjunto


#Preparacion de datos
Model2<-total%>%select(Id,BsmtQual,ExterQual,FireplaceQu,GarageFinish,KitchenQual,SalePrice)
ModelTrain2<-Model2%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)


GGP4<-ggpairs(ModelTrain2, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo")
GGP4<-GGP4+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP4

GGP5<-ggpairs(ModelTrain2, lower = list(continuous = my_rg2), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: B Splines (bs)-Purpura y Modelo lineal polinomico (poly)-Naranja")
GGP5<-GGP5+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP5

GGP6<-ggpairs(ModelTrain2, lower = list(continuous = my_rg4), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo lineal con intervalo de confianza - Purpura")
GGP6<-GGP6+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP6

De las tres grafica la mas interesante es esta ultima. En la primera nos queda claro que un ajuste de regresión local con Loess no sirve, salvo quizás en FireplaceQu

Veamos ahora una por una como se adaptan mejor si a un modelo lineal o suavizado con B Splines

#Plots individuales
p51<-getPlot(GGP5,6,1)
p52<-getPlot(GGP5,6,2)
p53<-getPlot(GGP5,6,3)
p54<-getPlot(GGP5,6,4)
p55<-getPlot(GGP5,6,5)

p51<-p51+labs(title="BsmtQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p52<-p52+labs(title="ExterQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p53<-p53+labs(title="FireplaceQu")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p54<-p54+labs(title="GarageFinish")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p55<-p55+labs(title="KitchenQual")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))

p51

p52

p53

p54

p55

A la hora de comparar entre el modelo lineal (línea purpura) y las curvas suavizadas B Splines vemos que todas quedan mejor explicadas por la B Spline salvo FireplaceQu pero esta solo se verá numericamente

2.3 CATEGORICAS

En cuanto al resto de variables categoricas , no se puede hacer ningún análisis grafico por la propia composición de la variable.

Si podemos ver una matriz de graficos de sus variables origen ordenadas por la variable destino

#preparacion
Model3<-total%>%select(Id,Neighborhood,Foundation,GarageType,MSSubClass,SalePrice)
ModelTrain3<-Model3%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)

ModelTrain3$Neighborhood<-reorder(ModelTrain3$Neighborhood,ModelTrain3$SalePrice,FUN = 'mean')
ModelTrain3$Foundation<-reorder(ModelTrain3$Foundation,ModelTrain3$SalePrice,FUN = 'mean')
ModelTrain3$GarageType<-reorder(ModelTrain3$GarageType,ModelTrain3$SalePrice,FUN = 'mean')
ModelTrain3$MSSubClass<-reorder(ModelTrain3$MSSubClass,ModelTrain3$SalePrice,FUN = 'mean')

GGP7<-ggpairs(ModelTrain3, lower = list(combo = 'box'), diag = list(continuous = "densityDiag"), axisLabels = "none",cardinality_threshold = 25,title='Variables Categoricas')
GGP7<-GGP7+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP7

GGP8<-ggpairs(ModelTrain3, lower = list(combo = 'dot'), diag = list(continuous = "densityDiag",discrete='barDiag'), axisLabels = "none",cardinality_threshold = 25,title='Variables Categoricas')
GGP8<-GGP8+theme(plot.title = element_text(color='darkorange',hjust=.3,size=32,lineheight = 1))
GGP8

Si vemos en detalle las graficas

#Plots individuales
p81<-getPlot(GGP8,5,1)
p82<-getPlot(GGP8,5,2)
p83<-getPlot(GGP8,5,3)
p84<-getPlot(GGP8,5,4)

p81<-p81+labs(title="Neighborhood")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p82<-p82+labs(title="Foundation")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p83<-p83+labs(title="GarageType")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p84<-p84+labs(title="MSSubClass")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))

p81

p82

p83

p84

Vemos que se puede apreciar cierta linealidad

Si vemos ahora con la agrupación de clusters y ordenadas

#DUMMYS
#preparacion
Model4<-total%>%select(Id,Vecindario,Cimientos,UbicaGarage,Clases,SalePrice)
ModelTrain4<-Model4%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)

ModelTrain4$Vecindario<-reorder(ModelTrain4$Vecindario,ModelTrain4$SalePrice,FUN = 'mean')
ModelTrain4$Cimientos<-reorder(ModelTrain4$Cimientos,ModelTrain4$SalePrice,FUN = 'mean')
ModelTrain4$UbicaGarage<-reorder(ModelTrain4$UbicaGarage,ModelTrain4$SalePrice,FUN = 'mean')
ModelTrain4$Clases<-reorder(ModelTrain4$Clases,ModelTrain4$SalePrice,FUN = 'mean')


GGP9<-ggpairs(ModelTrain4, lower = list(combo='dot'), diag = list(continuous = "densityDiag"), axisLabels = "none")
GGP9<-GGP9+theme(plot.title = element_text(color='darkorange',hjust=.3,size=42,lineheight = 1))
GGP9

#Plots individuales
p91<-getPlot(GGP9,5,1)
p92<-getPlot(GGP9,5,2)
p93<-getPlot(GGP9,5,3)
p94<-getPlot(GGP9,5,4)

p91<-p91+labs(title="Neighborhood")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p92<-p92+labs(title="Foundation")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p93<-p93+labs(title="GarageType")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p94<-p94+labs(title="MSSubClass")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))

p91

p92

p93

p94

Aquí vemos dos conclusiones importantes:

Mantenemos la aparente linealidad que teníamos antes de agrupar las categorias
Es posible eliminar un cluster mas en Cimientos como se había apuntado, pero ahora se ve mejor

#Revision de cimientos . Reduccion de 5 clusters

#Columnas con valores categoricos
NFact<-which(sapply(total,is.factor))
TotalFact<-total[,NFact]
#Añado variables numericas Id y SalePrice
TotalFact$Id<-total$Id
TotalFact$SalePrice<-total$SalePrice
TrainFact<-TotalFact%>%filter(is.na(SalePrice)==FALSE)

#Cimientos 3 y 4 clusters
train.prueba<-TrainFact%>%group_by(Foundation)
train.prueba2<-train.prueba%>%summarise(media=mean(SalePrice))
rownames(train.prueba2)<-train.prueba2$Foundation
train.hcl<-hclust(dist(train.prueba2))
train.dat<-rownames(train.prueba2)
train.dat<-as.data.frame(train.dat)
train.dat[,2]<-paste0('Cimientos',cutree(train.hcl,k=3))
train.dat[,3]<-paste0('Cimientos',cutree(train.hcl,k=4))
TotalFact$FoundationMean3<-TotalFact$Foundation
TotalFact$FoundationMean4<-TotalFact$Foundation
levels(TotalFact$FoundationMean3)<- train.dat[,2]
levels(TotalFact$FoundationMean4)<- train.dat[,3]

#Carga  provisional en dataset
total$Cimientos1<-TotalFact$FoundationMean3
total$Cimientos2<-TotalFact$FoundationMean4

Y aquí están los resultados para 3, 4 y 5 clusters

#Recarga de informacion
Model5<-total%>%select(Id,Cimientos1,Cimientos2,Cimientos,SalePrice)
ModelTrain5<-Model5%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)

ModelTrain5$Cimientos1<-reorder(ModelTrain5$Cimientos1,ModelTrain5$SalePrice,FUN = 'mean')
ModelTrain5$Cimientos2<-reorder(ModelTrain5$Cimientos2,ModelTrain5$SalePrice,FUN = 'mean')
ModelTrain5$Cimientos<-reorder(ModelTrain5$Cimientos,ModelTrain5$SalePrice,FUN = 'mean')

GGP10<-ggpairs(ModelTrain5, lower = list(combo='dot'), diag = list(continuous = "densityDiag"), axisLabels = "none",title='Resultados para cluster de Cimientos: 3 , 4 o 5')
GGP10<-GGP10+theme(plot.title = element_text(color='darkorange',hjust=.3,size=42,lineheight = 1))
GGP10

En detalle

p101<-getPlot(GGP10,4,1)
p102<-getPlot(GGP10,4,2)
p103<-getPlot(GGP10,4,3)

p101<-p101+labs(title="Cluster n=3")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p102<-p102+labs(title="Cluster n=4")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p103<-p103+labs(title="Cluster n=5")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))

p101

p102

p103

Graficamente la mejor opcion es n=3. Ademas vimos en la sección anterior que no había tanta diferencia

kable(Resultados.cimientos)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))%>%row_spec(1,background = 'orange')%>%row_spec(2,background = 'lawngreen')

Numero clusters	R2 Media	R2 Mediana	Diferencia_Media_Mediana
2	0.0568254698693131	0.247754678851469	-0.190929208982156
3	0.254395725745173	0.248262307945321	0.00613341779985199
4	0.2548092461983	0.252170668995711	0.00263857720258898
5	0.256199967397587	0.255658927697032	0.000541039700554968
Todos	0.256368401530415	0.256368401530415	0

#Se escoge 3 cluster
total$Cimientos<-total$Cimientos1
total$Cimientos1<-NULL
total$Cimientos2<-NULL

Se realiza la transformación de las categorías de las variables no numéricas en variables dummy

#Columnas con valores categoricos
NFact<-which(sapply(total,is.factor))
TotalFact1<-total[,NFact]
#Añado variables numericas Id y SalePrice
TotalFact1$Id<-total$Id

#Conversion a Dummys
Total.dummy.B<-TotalFact1%>%select(Id,B=Vecindario)
Total.dummy.C<-TotalFact1%>%select(Id,C=Cimientos)
Total.dummy.G<-TotalFact1%>%select(Id,G=UbicaGarage)
Total.dummy.N<-TotalFact1%>%select(Id,N=Clases)

modelo1.B<-as.data.frame(model.matrix(~.,Total.dummy.B))
modelo1.C<-as.data.frame(model.matrix(~.,Total.dummy.C))
modelo1.G<-as.data.frame(model.matrix(~.,Total.dummy.G))
modelo1.N<-as.data.frame(model.matrix(~.,Total.dummy.N))
modelo1.B$`(Intercept)`<-NULL
modelo1.C$`(Intercept)`<-NULL
modelo1.G$`(Intercept)`<-NULL
modelo1.N$`(Intercept)`<-NULL

modelo1<-modelo1.B
modelo1<-cbind(modelo1,modelo1.C%>%select(-Id))
modelo1<-cbind(modelo1,modelo1.G%>%select(-Id))
modelo1<-cbind(modelo1,modelo1.N%>%select(-Id))
#Modelo con dummys
Cuant<-total%>%select(Antiguedad,AntGarage,AreaPiso,BsmtQual,ExterQual,FireplaceQu,GarageFinish,GarageTotal,Habitat,KitchenQual,OverallQual,SalePrice)
modelo1.dummy<-cbind(modelo1,Cuant)
#Modelo con variables categoricas
Total.dummy<-total%>%select(Id,Vecindario,Cimientos,UbicaGarage,Clases)
modelo1.Nodummy<-cbind(Total.dummy,Cuant)

2.4 OUTLIERS

Si recordamos encontramos dos valores outliers .

El registro 524 que tenia discordancia entre los años de construcción remodelación y venta(corregido) y además tenia un precio muy bajo para el área habitable en sotano y primer piso.

Eso mismo le pasaba al registro 1299 que tenia un precio muy bajo para el área habitable y además no tenia proporción entre el área habitable, las habitaciones y los baños

En principio tenia pensado dejarles por que además en común con estos dos teniamos el registro 2550 que tenia discordancia en los años y falta de proporción entre el área habitable, las habitaciones y los baños, y este registro esta en el Test, pero he creido mas conveniente eliminarles de los datos

Antes de eliminarlos vamos a comprobar que posición ocupan en las variables numéricas normalizadas porque si son el valor extremo, máximo o minimo , al eliminarlo deberemos volver a normalizar esa variable con el nuevo extremo

#Vemos valores de variables numericas de los outliers por si hay que volver a normalizar
kable(modelo1.Nodummy%>%slice(524)%>%select(Id,Antiguedad,AntGarage,AreaPiso,GarageTotal,Habitat,OverallQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	Antiguedad	AntGarage	AreaPiso	GarageTotal	Habitat	OverallQual
524	0	0	0.5676347	0.35645161	0.75770895	1

kable(modelo1.Nodummy%>%slice(1299)%>%select(Id,Antiguedad,AntGarage,AreaPiso,GarageTotal,Habitat,OverallQual))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id	Antiguedad	AntGarage	AreaPiso	GarageTotal	Habitat	OverallQual
1299	0	0	1	0.3811828	0.91658963	1

Tanto Antigüedad como AntGarage ,y OverallQuall tienen varios registros con el mismo valor que el que vamos a eliminar, .

Sin embargo en AreaPiso el registro 1299 es el máximo. Cuando le eliminemos hay que normalizar de nuevo

#Eliminacion registros y normalizado AreaPiso en ambos dataset
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=524)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1299)
modelo1.dummy$AreaPiso<-normalize(modelo1.dummy$AreaPiso)

modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=524)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1299)
modelo1.Nodummy$AreaPiso<-normalize(modelo1.Nodummy$AreaPiso)

modelo1.Nodummy.train<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(AreaPiso,GarageTotal,Habitat,SalePrice)

Volvemos a cargar los graficos y comparamos

Afectaban sobre todo a AreaPiso, GarageTotal y Habitat

GGP11<-ggpairs(modelo1.Nodummy.train, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo")

p131<-getPlot(GGP11,4,1)
p141<-getPlot(GGP11,4,2)
p151<-getPlot(GGP11,4,3)


p131<-p131+labs(title="AreaPiso")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p141<-p141+labs(title="GarageTotal")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p151<-p151+labs(title="Habitat")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))

p13

p131

p14

p141

p15

p151

Han mejorado tanto AreaPiso como Habitat

Sin embargo tenemos otros outliers que aparecen en GarageTotal

Les seleccionamos y vemos su influencia en las dos variable anteriores (puntos en rojo)

p132<-p131+geom_point(data=modelo1.Nodummy.train,aes(x=modelo1.Nodummy.train$AreaPiso,y=modelo1.Nodummy.train$SalePrice,colour=modelo1.Nodummy.train$GarageTotal>0.5 & modelo1.Nodummy.train$SalePrice<300000))+scale_colour_manual(values = c(alpha("black",0), "red"))+theme(legend.position = 'none')
p152<-p151+geom_point(data=modelo1.Nodummy.train,aes(x=modelo1.Nodummy.train$Habitat,y=modelo1.Nodummy.train$SalePrice,colour=modelo1.Nodummy.train$GarageTotal>0.5 & modelo1.Nodummy.train$SalePrice<300000))+scale_colour_manual(values = c(alpha("black",0), "red"))+theme(legend.position = 'none')
p132

p152

kable(total%>%filter(GarageTotal>0.5 & SalePrice<300000)%>%select(Id))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

Id
582
1062
1191
1351

Los eliminamos, actualizamos, normalizamos y volvemos a revisar los graficos

#Eliminacion registros y normalizado AreaPiso en ambos dataset
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=582)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1062)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1191)
modelo1.dummy<-modelo1.dummy%>%slice()%>%filter(Id!=1351)
modelo1.dummy$AreaPiso<-normalize(modelo1.dummy$AreaPiso)

modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=582)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1062)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1191)
modelo1.Nodummy<-modelo1.Nodummy%>%slice()%>%filter(Id!=1351)
modelo1.Nodummy$AreaPiso<-normalize(modelo1.Nodummy$AreaPiso)

modelo1.Nodummy.train<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(AreaPiso,GarageTotal,Habitat,SalePrice)

Volvemos a cargar los graficos y comparamos

Afectaba sobre todo a GarageTotal

GGP12<-ggpairs(modelo1.Nodummy.train, lower = list(continuous = my_rg1), diag = list(continuous = "densityDiag"), axisLabels = "none",title="Regresion: Modelo Lineal (lm)-Cyan y Suavizado Local(Loess)-Rojo")

p132<-getPlot(GGP12,4,1)
p142<-getPlot(GGP12,4,2)
p152<-getPlot(GGP12,4,3)


p132<-p132+labs(title="AreaPiso")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p142<-p142+labs(title="GarageTotal")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))
p152<-p152+labs(title="Habitat")+theme(plot.title = element_text(color='darkorchid1',hjust=.3,size=22,lineheight = 1))

p131

p132

p141

p142

p151

p152

3 SELECCION Y PREDICCION

3.1 FILTRADO

Vamos a realizar un filtrado de las variables mediante el método sbf() del paquete caret

Vamos a realizarlo con dos funciones internas diferentes para poder comparar y validar los resultados , ramdom forest y modelo lineal

#FILTRADO DE VARIABLES CON CARET
#Filtrado con sbf de caret usando RandomForest y Linear Model

# Se crea una semilla para cada partición y cada repetición: el vector debe 
# tener B+1 semillas donde B = particiones * repeticiones.

ModeloTrain.Nodummy<-modelo1.Nodummy%>%filter(is.na(SalePrice)==FALSE)%>%select(-Id)
set.seed(456)
particiones = 10 
repeticiones = 5
seeds <- sample.int(1000, particiones * repeticiones + 1)

# Control del filtrado Random Forest
ctrl_filtrado.rf <- sbfControl(functions = rfSBF, method = "repeatedcv", number = particiones, repeats = repeticiones, seeds = seeds, verbose = FALSE, saveDetails = TRUE)

# Control del filtrado Linear Model
ctrl_filtrado.lm <- sbfControl(functions = lmSBF, method = "repeatedcv", number = particiones, repeats = repeticiones, seeds = seeds, verbose = FALSE, saveDetails = TRUE)

set.seed(234) 
rf_sbf <- sbf(SalePrice ~ ., data = ModeloTrain.Nodummy, sbfControl = ctrl_filtrado.rf,ntree = 500) 

lm_sbf <- sbf(SalePrice ~ ., data = ModeloTrain.Nodummy, sbfControl = ctrl_filtrado.lm)

#Vemos las variables que tenems quequedarnos
kable(rf_sbf$optVariables)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover")) #optimas variables segun Random Forest

x
VecindarioBarrio2
VecindarioBarrio3
VecindarioBarrio4
VecindarioBarrio5
CimientosCimientos2
CimientosCimientos3
UbicaGarageGarage2
UbicaGarageGarage3
UbicaGarageGarage4
ClasesClase2
ClasesClase3
ClasesClase4
ClasesClase6
Antiguedad
AntGarage
AreaPiso
BsmtQual
ExterQual
FireplaceQu
GarageFinish
GarageTotal
Habitat
KitchenQual
OverallQual

kable(lm_sbf$optVariables)%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover")) #optimas variables segun Linear Model

x
VecindarioBarrio2
VecindarioBarrio3
VecindarioBarrio4
VecindarioBarrio5
CimientosCimientos2
CimientosCimientos3
UbicaGarageGarage2
UbicaGarageGarage3
UbicaGarageGarage4
ClasesClase2
ClasesClase3
ClasesClase4
ClasesClase6
Antiguedad
AntGarage
AreaPiso
BsmtQual
ExterQual
FireplaceQu
GarageFinish
GarageTotal
Habitat
KitchenQual
OverallQual

Podemos apreciar que los resultados son iguales

De las 25 variables solo se ha descartado 1

Aplicamos los resultado y eliminamos variable no influyente

Modelo2.Filtrado<-modelo1.dummy%>%select(-NClase5)
Modelo2Train.Filt<-Modelo2.Filtrado%>%filter(is.na(SalePrice)==FALSE)

3.2 MODELADO

Antes de empezar a modelizar tenemos que eliminar la variable Id de ambos dataset, pero guardando una copia para poder enviar la respuesta

#Copia seguridad y eliminacion ID
CopiaTrain<-Modelo2Train.Filt
CopiaTest<-Modelo2.Filtrado%>%filter(is.na(SalePrice)==TRUE)

TrainFinal<-CopiaTrain%>%select(-Id)
TestFinal<-CopiaTest%>%select(-Id,-SalePrice)

Para la fijación de nuesro modelo vamos a elegir el método de la validación cruzada del dataset Train con 20 iteraciones

No sabiendo que modelo elegir, para lo cual probaremos con el método train del paquete caret diversos modelos y veremos que resultados nos aportan

Una cosa interesante que aporta este metodo es que llama a los diversos metodos de distintos paquetes con diferentes hiperparametros y se encarga de seleccionar los parametros propios de cada metodo mas eficientes

#PRUEBAS MODELOS
set.seed(234)
#MultiVariate Adaptative Regression Splines
MARS<-train(TrainFinal[,-25],TrainFinal[,25],'gcvEarth',trControl = trainControl(method = 'cv',number = 20))

#Modelo lineal
LM<-train(TrainFinal[,-25],TrainFinal[,25],'lm',trControl = trainControl(method = 'cv',number = 20))

#Ramdom Forest
RF<-train(TrainFinal[,-25],TrainFinal[,25],'ranger',trControl = trainControl(method = 'cv',number = 20))         

#Modelo lineal+splines
rlm<-lm(formula = SalePrice~.,data=TrainFinal)

rnd<-lm(formula=SalePrice~bs(Antiguedad)+bs(OverallQual)+bs(BsmtQual)+bs(ExterQual)+bs(FireplaceQu)+bs(GarageFinish)+bs(KitchenQual)+AntGarage+AreaPiso+GarageTotal+Habitat+BBarrio2+BBarrio3+BBarrio4+BBarrio5+CCimientos2+CCimientos3+GGarage2+GGarage3+GGarage4+NClase2+NClase3+NClase4+NClase6 ,data=TrainFinal)

rnd2<-lm(formula=SalePrice~ns(Antiguedad)+ns(OverallQual)+ns(BsmtQual)+ns(ExterQual)+ns(FireplaceQu)+ns(GarageFinish)+ns(KitchenQual)+AntGarage+AreaPiso+GarageTotal+Habitat+BBarrio2+BBarrio3+BBarrio4+BBarrio5+CCimientos2+CCimientos3+GGarage2+GGarage3+GGarage4+NClase2+NClase3+NClase4+NClase6 ,data=TrainFinal)

#Generalized Additice Model using SPLINE
GAMS<-train(TrainFinal[,-25],TrainFinal[,25],'gamSpline',trControl = trainControl(method = 'cv',number = 20))

#Generalize Linear Models
GLM<-train(TrainFinal[,-25],TrainFinal[,25],'glm',trControl = trainControl(method = 'cv',number = 20))

#Bayesian Ridge Regression
BRR<-train(TrainFinal[,-25],TrainFinal[,25],'bridge',trControl = trainControl(method = 'cv',number = 20))

#Bayesian Ridge Regression (Model Averaged)
BLASSO<-train(TrainFinal[,-25],TrainFinal[,25],'blassoAveraged',trControl = trainControl(method = 'cv',number = 20))

#Extreme gradient boosting
XGB<-train(TrainFinal[,-25],TrainFinal[,25],'xgbLinear',trControl = trainControl(method = 'cv',number = 20))

XGBT<-train(TrainFinal[,-25],TrainFinal[,25],'xgbTree',trControl = trainControl(method = 'cv',number = 20))

3.3 RESULTADOS

Vamos a comparar los modelos elegidos

#Comprobacion resultados
options(digits=6)
model<-list(gcvEarth=MARS,lm=LM,ranger=RF,gamSpline=GAMS,glm=GLM,bridge=BRR,blassoAveraged=BLASSO,xgbLinear=XGB,xgbTree=XGBT)
result.resamples<-resamples(model)
metricas_resamples <- result.resamples$values%>%gather(key = "modelo", value = "valor", -Resample)%>%separate(col = "modelo", into = c("modelo", "metrica"), sep = "~", remove = TRUE)

#Tabla resultados

kable(metricas_resamples %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(Rsquared)))%>%kable_styling(full_width = F,bootstrap_options = c("striped", "hover"))

modelo	MAE	RMSE	Rsquared
xgbTree	17900.3	25888.2	0.891002
ranger	17796.4	26444.9	0.890143
gcvEarth	18527.0	26813.4	0.882849
gamSpline	19205.6	27160.8	0.882141
xgbLinear	19324.2	27388.8	0.881359
bridge	20573.4	29588.9	0.864643
blassoAveraged	20444.0	29604.4	0.864640
lm	20440.4	29307.8	0.863801
glm	20408.2	29537.1	0.862450

#Calculos para ponderaciones
RS<-metricas_resamples%>%filter(metrica=="Rsquared") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(Rsquared))
RSM<-metricas_resamples%>%filter(metrica=="MAE") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(MAE))
RSE<-metricas_resamples%>%filter(metrica=="RMSE") %>% group_by(modelo, metrica) %>% summarise(media = mean(valor)) %>% spread(key = metrica, value = media) %>% arrange(desc(RMSE))
RST<-RS%>%spread(modelo,Rsquared)
RSMT<-RSM%>%spread(modelo,MAE)
RSET<-RSE%>%spread(modelo,RMSE)

Vemos graficamente

#Grafico
graf1<-metricas_resamples %>% filter(metrica == "Rsquared") %>% group_by(modelo) %>% summarise(media = mean(valor)) %>% ggplot(aes(x = reorder(modelo, media), y = media, label = sprintf("%0.4f",round(media, 4)))) 
graf1<-graf1+ geom_segment(aes(x = reorder(modelo, media), y = 0, xend = modelo, yend = media), color = "grey50")
graf1<-graf1+ geom_point(size = 10, color = "firebrick") + geom_text(color = "white", size = 2.5) + scale_y_continuous(limits = c(0.75, 1)) 
graf1<-graf1 + labs(title = "Rsquare con CV", subtitle = "Modelos ordenados por media", x = "modelo") 
graf1<-graf1+ coord_flip() + theme_bw()
graf1
## Warning: Removed 9 rows containing missing values (geom_segment).

  
graf2<-bwplot(result.resamples,scales=list(relation="free"),xlim=list(c(13000,30000),c(18000,50000),c(0.7,1)))
graf2

Los modelos que parecen mas efectivos son RandomForest, y xgbTree

ranger: RandomForest es un ensamble en paralelo (bagging) de arboles de predicción en los que se selecciona aleatoriamente los predictores en cada nodo
xgbTree: eXtreme Gradient Boosting es un ensamble secuencial (boosting) de arboles de predicción en el que cada árbol intenta minimizar los residuos del anterior

Los otros modelos que también dan buenos resultados son:

GAMSpline :Generalized Additive Model using Splines es una combinacion lineal de funciones no lineales.Se trata de combinar distintos tipos de regresión en un conjunto no lineal, usando aquí smooth Splines
gvcEarth: MultiVariate Adaptative Regression Splines es parecido al anterior pero usando regression splines
XGBLinear es un un ensamble secuencial como XGBoost pero orientado hacia el modelo lineal

3.4 PREDICCION

En un data frame elijo en varias columnas las predicciones que me da cada modelo

#Calculo para distintas ponderaciones
SumaRs<-RST$ranger+RST$gamSpline+RST$xgbTree+RST$gcvEarth+RST$xgbLinear
SumaRSM<-((1/RSMT$ranger)+(1/RSMT$gamSpline)+(1/RSMT$xgbTree)+(1/RSMT$gcvEarth)+(1/RSMT$xgbLinear))
SumaRSE<-((1/RSET$ranger)+(1/RSET$gamSpline)+(1/RSET$xgbTree)+(1/RSET$gcvEarth)+(1/RSET$xgbLinear))
#Prediccion
result<-CopiaTest%>%select(-SalePrice)
result$RF<-predict(RF,TestFinal)
result$GAM<-predict(GAMS,TestFinal)
result$XGBT<-predict(XGBT,TestFinal)
result$MARS <-predict(MARS,TestFinal)
result$XGB <-predict(XGB,TestFinal)
result$media<-round(((result$RF+result$GAM+result$XGBT+result$MARS+result$XGB)/5),digits = 1)
#ponderada sobre Rsquared
result$ponderada<-round((((result$RF*RST$ranger)+(result$GAM*RST$gamSpline)+(result$XGBT*RST$xgbTree)+(result$MARS*RST$gcvEarth)+(result$XGB*RST$xgbLinear))/SumaRs),digits = 1)
#Ponderada sobre MAE
result$ponderada1<-round((((result$RF/RSMT$ranger)+(result$GAM/RSMT$gamSpline)+(result$XGBT/RSMT$xgbTree)+(result$MARS/RSMT$gcvEarth)+(result$XGB/RSMT$xgbLinear))/SumaRSM),digits = 1)
#Ponderada sobre RMSE
result$ponderada2<-round((((result$RF/RSET$ranger)+(result$GAM/RSET$gamSpline)+(result$XGBT/RSET$xgbTree)+(result$MARS/RSET$gcvEarth)+(result$XGB/RSET$xgbLinear))/SumaRSE),digits = 1)

#Redondeo hacia arriba en centenas de los valores
result$RF<-100*ceiling((result$RF/100))
result$GAM<-100*ceiling((result$GAM/100))
result$XGBT<-100*ceiling((result$XGBT/100))
result$MARS<-100*ceiling((result$MARS/100))
result$XGB<-100*ceiling((result$XGB/100))
result$media<-100*ceiling((result$media/100))
result$ponderada<-100*ceiling((result$ponderada/100))
result$ponderada1<-100*ceiling((result$ponderada1/100))
result$ponderada2<-100*ceiling((result$ponderada2/100))

Fin<-result%>%select(Id,SalePrice=media)
Fin1<-result%>%select(Id,SalePrice=RF)
Fin2<-result%>%select(Id,SalePrice=GAM)
Fin3<-result%>%select(Id,SalePrice=XGBT)
Fin4<-result%>%select(Id,SalePrice=MARS)
Fin5<-result%>%select(Id,SalePrice=XGB)
Fin6<-result%>%select(Id,SalePrice=ponderada)
Fin7<-result%>%select(Id,SalePrice=ponderada1)
Fin8<-result%>%select(Id,SalePrice=ponderada2)

write.csv(Fin,file="Ames2_house.csv",row.names = FALSE)
write.csv(Fin1,file="Ames2_house1.csv",row.names = FALSE)
write.csv(Fin2,file="Ames2_house2.csv",row.names = FALSE)
write.csv(Fin3,file="Ames2_house3.csv",row.names = FALSE)
write.csv(Fin4,file="Ames2_house4.csv",row.names = FALSE)
write.csv(Fin5,file="Ames2_house5.csv",row.names = FALSE)
write.csv(Fin6,file="Ames2_house6.csv",row.names = FALSE)
write.csv(Fin7,file="Ames2_house7.csv",row.names = FALSE)
write.csv(Fin8,file="Ames2_house8.csv",row.names = FALSE)

3.5 TEST

Estos son los resultado en Kaggle.

El valor corresponde al resultado aplicado al TEST que nos da RMSLE: Root Mean Squared Logarithmic Error similar al RMSE pero aplicando una reduccion logaritmica previa a los datos

include_graphics('Kaggle1.bmp')

Podemos apreciar que los valores son muy parecidos tanto en la media directa de los modelos escogidos como en aquella ponderacion con el criterio que sea

include_graphics('Kaggle2.bmp')

Aunque se mantiene el orden de eficiencia que habiamos obtenido de los modelos durante el entrenamiento , hay que destacar que cualquier mezcla de varios sea con el criterio que sea de ponderacion es mejor que el mejor de los modelos en solitario

	Var1	Var2	Var3	Freq
144	Unf	TA	TA	268
128	Unf	Fa	TA	40
32	Unf	Fa	Fa	25
48	Unf	TA	Fa	18
143	RFn	TA	TA	6
104	Unf	Fa	Po	4

	Var1	Var2	Var3	Freq
144	Unf	TA	TA	268
128	Unf	Fa	TA	40
32	Unf	Fa	Fa	25
48	Unf	TA	Fa	18
143	RFn	TA	TA	6
104	Unf	Fa	Po	4

R Notebook

1 PREPARACION

1.1 ESTRUCTURA DE LOS DATOS

1.2 VARIABLES

1.2.1 VARIABLES CUANTIFICADAS (integer)

1.2.2 VARIABLES CATEGORICAS (Caracter)

1.2.3 VARIABLES CATEGORICAS YA CUANTIFICADAS (Integer)

1.3 VALORES NULOS Y PERDIDOS

1.3.1 GARAJE

1.3.1.1 GARAGE TYPE

1.3.1.2 GARAGE CARS y GARAGE AREA

1.3.1.2.1 Registro 2577

1.3.2 SOTANO (BASEMENT)

1.3.2.0.1 Registro 333 (BsmtFinType2=NONE)

1.3.2.0.2 Registros 949,1488 y 2349 (BsmtExposure=NONE)

1.3.2.0.3 Registros 2041,2186 y 2525 (BsmtCond=NONE)

1.3.2.0.4 Registros 2218 y 2219 (BsmtQual=NONE)

1.3.3 MAMPOSTERIA (MasVnr)

1.3.4 PROPIEDAD (Lot)

1.3.5 EXTERIOR

1.3.6 UTILIDADES (Utilities)

1.3.7 FUNCIONAL (Functional)

1.3.8 ELECTRICO (Electrical)

1.3.9 COCINA (Kitchen)

1.3.10 VENTA (Sale)

1.3.11 ZONIFICACION

1.3.12 CONCLUSION

1.4 CONTRADICCIONES

1.4.1 PISCINA (Pool)

1.4.2 CHIMENEA (Fireplace)

1.4.3 SOTANO (Basement)

1.4.4 GARAGE

1.5 CAMBIOS EN TIPOLOGIAS

1.5.1 CATEGORICAS

1.5.2 ORDINALES

1.5.3 CUANTITATIVAS

1.5.3.1 MOSOLD (Mes venta)

1.5.3.2 YRSOLD (Año venta)

1.5.3.3 YearBuilt YearRemodAdd (Año de construccion y Año de remodelacion)

1.5.3.4 GarageYrBuilt (Año en el que fue construido el garage)

1.5.3.5 REVISION RESTO CUANTITATIVAS (Sin relacion con fechas)

1.5.3.5.1 ANTIGUEDAD y ANTGARAGE

1.5.3.5.2 GARAGECARS Y GARAGEAREA

1.5.3.5.3 FIREPLACES y FIREPLACEQU

1.5.3.5.4 1STFlRSF y TOTALBSMTSF

1.5.3.5.5 GRLIVAREA FULLBATH TOTRMSABVGRD

1.5.3.5.6 Normalizacion de resto de variables

1.5.3.5.7 CONCLUSION

1.5.4 FACTORES

1.5.4.1 NEIGHBORHOOD (Vecindario)

1.5.4.2 FOUNDATION (Cimientos)

1.5.4.3 GARAGETYPE (Ubicacion del garage)

1.5.4.4 MSSUBCLASS (CLase de construccion)

1.5.4.5 CONCLUSIONES

2 MODELIZACION

2.1 NUMERICAS Continuas y discreta con muchas agrupaciones

2.2 NUMERICAS discretas (resto)

2.3 CATEGORICAS

2.4 OUTLIERS

3 SELECCION Y PREDICCION

3.1 FILTRADO

3.2 MODELADO

3.3 RESULTADOS

3.4 PREDICCION

3.5 TEST

	Var1	Var2	Var3	Freq
144	Unf	TA	TA	268
128	Unf	Fa	TA	40
32	Unf	Fa	Fa	25
48	Unf	TA	Fa	18
143	RFn	TA	TA	6
104	Unf	Fa	Po	4